PROGRAM EXERCISE23 IMPLICIT NONE ! 割線法でf(x)=0の解を求めるプログラム REAL*8 :: x_1, x_2, f_1, f_2, x_sec, f_sec, eps=1.0d-14 INTEGER :: iter ! x_1とx_2の初期値 x_1 = 0.0d0 x_2 = 10.0d0 ! f(x_L)とf(x_R)を計算 f_1 = f(x_1) f_2 = f(x_2) ! 反復の回数カウンタ iter = 1 ! 反復のループ DO ! 割線の次の点を計算 x_sec = x_2 - (x_2 - x_1)/(f_2 -f_1)*f_2 f_sec = f(x_sec) ! インデックスをずらす x_1 = x_2 f_1 = f_2 x_2 = x_sec f_2 = f_sec ! 反復の途中経過を出力 PRINT *, "iter = ", iter, "x_sec = ", x_sec, "f_sec = ", f_sec ! f_secが十分ゼロに近づいたらDOループから抜ける IF( ABS(f_sec) .LT. eps) EXIT ! 反復カウンタを1増やす iter = iter + 1 ! もし問題が起きた場合1000回で反復を強制的に終了する IF( iter .EQ. 1000) STOP "iteration did not converge" END DO CONTAINS ! f(x)の値を返す関数副プログラム FUNCTION f(x) REAL*8, INTENT(IN) :: x REAL*8 :: f f = SIN(x/4.0d0) - COS(x/4.0d0) RETURN END FUNCTION f END PROGRAM EXERCISE23