编辑代码

PROGRAM EXAM14_1
USE BISECT!应用二分法模块
REAL X1,X2,X
DO
  PRINT*,'输入x1,x2的值:'!输入x1,x2,直到f(x1)和f(x2)异号为止
  READ*,X1,X2
  IF(FUNC(X1)*FUNC(X2)<0.0)EXIT
  PRINT*,'此区间无根,请重新输入!'
END DO
X=SOLVE(X1,X2)!调用求解函数
PRINT 10,'X=',X
10 FORMAT(A,F15.7)
END

MODULE BISECT
CONTAINS
REAL FUNCTION FUNC(X)!定义方程函数
IMPLICIT NONE
REAL X
FUNC=X**3-2*X**2+7*X+4
END FUNCTION FUNC
MODULE BISECT
CONTAINS
REAL FUNCTION FUNC(X)!定义方程函数
IMPLICIT NONE
REAL X
FUNC=X**3-2*X**2+7*X+4
END FUNCTION FUNC
REAL FUNCTION SOLVE(X1,X2)!二分法求解函数
IMPLICIT NONE
REAL X1,X2,X,F1,F2,FX
X=(X1+X2)/2.0
FX=FUNC(X)
DO WHILE(ABS(FX)>1E-6)
  F1=FUNC(X1)
  F2=FUNC(X2)
  IF(F1*FX<0)THEN
    X2=X
  ELSE
    X1=X
  ENDIF
  X=(X1+X2)/2.0
  FX=FUNC(X)
END DO
SOLVE=X
END FUNCTION SOLVE
END MODULE BISECT
PROGRAM EXAM14_2
USE SECANT
REAL X1,X2,X
DO
  PIRNT*,'输入X1,X2的值:'
  READ*,X1,X2
  IF(FUNC(X1)*FUNC(X2)<0)EXIT
  PRINT*,'此区间无跟,请重新输入!'
  END DO
X=SOLVE(X1,X2)!调用求解函数
PRINT 10,'X=',X
10 FORMAT(A,F15.7)
END
MODULE SECANT
CONTAINS
REAL FUNCTION FUNC(X)!定义方程函数
IMPLICIT NONE
REAL X
FUNC=X**3-2*X**2+7*X+4
END FUNCTION FUNC

REAL FUNCTION SOLVE(X1,X2)!弦截法求解函数
IMPLICIT NONE
REAL X1,X2,X,F1,F2,FX
X=X2-(X2-X1)/(FUNC(X2)-FUNC(X1))*FUNC(X2)!弦截法与二分法区别
FX=FUNC(X)
DO WHILE(ABS(FX)>1E-6)
  F1=FUNC(X1)
  F2=FUNC(X2)
  IF(F1*FX<0)THEN
    X2=X
  ELSE
    X1=X
  ENDIF
  X=X2-(X2-X1)/(FUNC(X2)-FUNC(X1))*FUNC(X2)!区别
  FX=FUNC(X)
END DO
SOLVE=X
END FUNCTION SOLVE
END MODULE SECANT
PROGRAM EXAM14_3
USE ITERATION
REAL X0
PRINT*,'输入初值X0:'
READ*,X0
CALL SOLVE(X0)!调用迭代法求解
END
MODULE ITERATION
IMPLICIT NONE
INTEGER::MAX=200!最大允许迭代次数
CONTAINS

REAL FUNCTION G(X)!定义迭代函数G(X)
IMPLICIT NONE
REAL X
G=(-X**3+2*X**2-4)/7
END FUNCTION G

SUBROUTINE SOLVE(X)!迭代法求解子程序
IMPLICIT NONE
REAL X,X1
INTEGER I
I=1
X1=G(X)
DO WHILE(ABS(X-X1)>1E-6.AND.I<=MAX)
  PRINT 10,I,X1
  X=X1
  I=I+1
  X1=G(X)
END DO
IF(I<=MAX)THEN
  PRINT 20,'X=',X1!输出计算结果
ELSE
  PRINT 30,'经过',MAX,'次迭代后仍未收敛'
ENDIF
10 FORMAT('I=',I4,6X,'X=',F15.7)
20 FORMAT(A,F15.7)
30 FORMAT(A,I4,A)
END SUBROUTINE SOLVE
END MODULE ITERATION
PROGRAM EXAM_14_4
USE NEWTON
REAL X0
PRINT*,'输入初值'
READ*,X0
CALL SOLVE(X0)!调用牛顿迭代法求解子程序
END
MODULE NEWTON
IMPLICIT NONE
INTEGER::MAX=200!最大允许迭代次数
CONTAINS
REAL FUNCTION FUNC(X)!定义方程
  IMPLICIT NONE
  REAL X
  FUNC=X**3-2*X**2+7*X+4
END FUNCTION FUNC
REAL FUNCTION DFUNC(X)!一次导数
  IMPLICIT NONE
  REAL X
  DFUNC=3*X**2-4*X+7
END FUNCTION DFUNC

SUBROUTINE SOLVE(X)!求解子程序
  IMPLICIT NONE
  REAL X,X1
  INTEGER I
  I=1
  X1=X-FUNC(X)/DFUNC(X)
  DO WHILE(ABS(X-X1)>1E-6.AND.I<=MAX)
    PRINT 10,I,X1
    X=X1
    I=I+1
    X1=X-FUNC(X)/DFUNC(X)
  END DO
IF(I<=MAX)THEN
  PRINT 20,'X=',X1!输出计算结果
ELSE
  PRINT 30,'经过',MAX,'次迭代后仍未收敛'
ENDIF
10 FORMAT('I=',I4,6X,'X=',F15.7)
20 FORMAT(A,F15.7,A)
30 FORMAT(A,I4,A)
END SUBROUTINE SOLVE
END MODULE NEWTON