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. OK, I Understand
 
Top