program main !==================================================================== ! A single root of an equation f(x)=0 in [x1,x2] interval ! Method: Open Domain (Method of secants) !==================================================================== implicit none double precision f,x1,root,eps integer flag external f x1 = -1.0 eps = 1.0e-7 write (*,*) ' A single root of f(x)' write (*,*) ' Method - Secant' write (*,100) x1 call Secant(f,x1,eps,Root,flag) ! print solutions if(flag == 0) then write(*,*)' no root found' stop end if write(*,101) eps, flag write(*,102) Root ! test solution write(*,104) f(Root) 100 format(' First point = ',f6.2) 101 format(' tolerance = ',1pe12.5,//,& ' iterations = ',i3) 102 format(' root = ',1pe12.5) 104 format(' f(root) = ',1pe12.5) end program main Subroutine Secant(f,x1,eps,Root,flag) !============================================================ ! Solutions of equation f(x)=0 around point x ! Methods: secant ! Alex G. January 2010 !------------------------------------------------------------ ! input ... ! f - function - evaluates f(x) ! x1 - a guess point ! eps - desired uncertainity of the root as f(Root)0 - a single root found, flag=number of iterations ! 0 - no solutions for the method of secants ! ! Comments: the method needs two points to start. We use x2=x1+h !==================================================================== implicit none double precision f, x1, eps, Root double precision x2, x3, h, df integer i, flag integer, parameter:: iter=200 !* initialize calculations h = 0.1 x2 = x1 + h !* Iterative refining the solution do i=1,iter df = (f(x2)-f(x1))/(x2-x1) x3 = x2 - f(x2)/df ! check the step. if it is improbably large - use bisection if(abs(x3) > 100.0*abs(x2)) x3 = (x2+x1)/2.0 ! condition(s) to stop iterations) if(abs(f(x3))<= eps) exit x1 = x2; x2 = x3; end do Root=x3 !* check the convergence if (i /= iter) then flag=i else flag = 0 end if end subroutine Secant !----------------------------------------------------- Function f(x) implicit none double precision f, x f = x + cos(x) end function f