• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# roots_lib

starm100 Apr 2nd, 2019 82 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module roots
2. contains
3.
4. subroutine kas(f,df,d2f,x1,x2,xk,eps,i,mm2,m1) !Метод касательных
5. implicit none
6. real(8)::f,df,d2f,x1,x2,eps,xk,mm2,m1
7. integer::i,imax=100
8. if (d2f(x1)*f(x1) .GT. 0) then !Определяем, с какого конца отрезка начать
9.     xk=x1
10. else if (d2f(x2)*f(x2) .GT. 0) then
11.     xk=x2
12. else
13.     print*,'Error, choose different x1 and x2'
14.     stop
15. end if
16. do while ((mm2/(2*m1)*(xk-xi)**2 .GT. eps) .AND. (i .LT. imax))
17.     xi=xk
18.     xk=xk-f(xk)/df(xk)
19.     i=i+1
20. end do
21. end subroutine kas
22.
23. subroutine hord(f,x1,x2,xk,eps,i,mm1,m1) !Метод хорд
24. implicit none
25. real(8)::f,x1,x2,x0,eps,xk,xi,mm1,m1
26. integer::i,imax=100
27. x0=x2
28. x2=x1-(f(x1)*(x1-x0))/(f(x1)-f(x0))
29. do while (((mm1-m1)/m1*abs(x2-x1) .GT. eps) .AND. (i .LT. imax))
30.     x1=x2
31.     x2=x1-(f(x1)*(x1-x0))/(f(x1)-f(x0))
32.     i=i+1
33. end do
34. xk=xi
35. end subroutine hord
36.
37. subroutine sec(f,x1,x2,xk,eps,i,m1) !Метод секущих
38. implicit none
39. real(8)::f,x1,x2,eps,xk,xi,temp,m1
40. integer::i,imax=100
41. xi=x1
42. xk=x2
43. do while ((abs(f(xk))/m1 .GT. eps) .AND. (i .LT. imax))
44.     temp=xk
45.     xk=xi-(f(xi)*(xk-xi))/(f(xk)-f(xi))
46.     xi=temp
47.     i=i+1
48. end do
49. end subroutine sec
50.
51. subroutine iter(f,x1,x2,xk,eps,i,m1,mm1) !Метод простой итерации
52. implicit none
53. real(8)::f,x1,x2,eps,xk,lambda,m1,mm1
54. integer::i,imax=100
55. lambda=1/mm1
56. q=1-m1/mm1
57. x0=(x1+x2)/2
58. xk=x0+lambda*f(x0)
59. do while ((q/(1-q)*abs(xk-x0) .GT. eps) .AND. (i .LT. imax))
60.     x0=xk
61.     xk=xk+lambda*f(xk)
62.     i=i+1
63. end do
64. end subroutine iter
65. end module roots
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top