编辑代码

program besect
    MODULE numerical 
      IMPLICIT none 
      REAL, PARAMETER:: zero = 0.00001 
      CONTAINS 
      REAL function bisect( a, b, func ) 
      IMPLICIT none 
      REAL a,b                   ! 输入的猜值 
      REAL c                     ! 用来算(a+b)/2 
      REAL fa                    ! 记录f(a) 
      REAL fb                    ! 记录f(b) 
      REAL fc                    ! 记录f(c) 
      REAL, EXTERNAL:: func      ! 所要求解的函数 
 
      c = (a+b)/2.0              ! 先求出c, f(c)的值
      fc = func(c)  
      DO WHILE( ABS(fc) > zero ) ! f(c)小于zero时,就视f(c)=0,结束循环
        fa = func(a) 
        fb = func(b) 
        IF( fa*fc < 0 ) THEN     ! f(a)*f(c)<0 ,以a,c值为新的区间
          b=c 
          c=(a+b)/2.0 
        ELSE                     ! 不然就是以b,c为新的区间
          a=c 
          c=(a+b)/2.0 
        END IF 
          fc=func(c)             ! 求出新的f(c)值
      ENDDO 
      bisect = c 
      RETURN 
      END function 

      REAL function f(x)         ! 求解用的函数
      IMPLICIT none 
      REAL x 
      f=(x+3)*(x-3) 
      RETURN 
      END function 

      END MODULE
      USE  numerical 
      IMPLICIT  none 
      REAL  a,b                 ! 两个猜值 
      REAL  ans                 ! 算出的值 
        
DO WHILE(.true.) 
        WRITE(*,*) "输入两个猜测值" 
        READ (*,*) a,b 
        IF(f(a)*f(b)<0) EXIT    ! f(a)*f(b)<0 的猜值才是有效的猜值
        WRITE(*,*) "不正确的猜值" 
      END DO 
      ans=bisect( a, b, f )     ! 调用二分法求根的函数
      WRITE(*,"('x=',F6.3)") ans      ! 写出结果
      END