自動變步長Simpson積分方法函數

Module mod
  Implicit none
  Real(kind=8), parameter :: a = 1.d0, b = 1.02d0  !// 積分區間
  Real(kind=8), parameter :: eps = 1.d-15  !// 誤差控制
  Real(kind=8) :: s  !// 最終積分結果
  Integer :: n  !// 最終分的份數
Contains
Subroutine solve( s, a, b, tol, n )
!//  Purpose   :  自動變步長Simpson積分方法函數
!    
!//  Input  parameters  :
!//       1.  func 外部函數
!//       2. 
!//       3.  a,b積分區間
!//       4.  tol  積分誤差容限
!
!//  Output parameters  :
!//       1.   s  積分結果
!//       2.   n  實際區間劃分個數
  Real(kind=8) :: s, s1, a, b, del, tol
  Integer :: n, i, m

  !//初始劃分40個子區間
  n = 40  !//n可以根據被積函數的複雜程序適當地減小或增大

  !//最大允許劃分100次
  m = 100  !//此處的m也可以根據被積函數的複雜程序適當地減小或增大
  Do i = 1, m
    call simp( s, a, b, n ) 
    n = n * 2
    call simp( s1, a, b, n )
    del = abs(s-s1)

    !//滿足精度後就停止循環
    if ( del < tol ) exit
  End do

  s = s1

end subroutine solve

Subroutine simp( s, a, b, n )
  Real(kind=8) :: s, a, b, h, f1, f2, f3, f4, t1, t2
  Integer :: n, k

  s = 0d0
  h = (b-a) / n / 2d0

  call func1( f1, a )
  call func1( f2, b )

  s = f1 + f2

  !//k=0 情況
  call func1( f1, a+h )
  s = s + 4d0*f1

  Do k = 1, n-1
    t1 = a + (2d0*k+1.d0) * h
    t2 = a + 2d0 * k * h

    call func1( f3, t1 )
    call func1( f4, t2 )

    s = s + f3*4d0 + f4*2d0  
  End do

  s = s*h / 3d0

End subroutine simp


Subroutine func1( f, x )
  Implicit none
  Real(kind=8) :: f, x
  f = -10.d0 * x**(-11.d0) !//被積函數(原函數的導數)
End subroutine func1

End module mod

Program main  !// 此程序一般只需更改積分區間[a,b],誤差限度eps,以及被積函數fun1
  use mod
  call solve( s, a, b, eps, n )
  write( *,'(1x,"區間劃分等份爲:",I5,/,1x,"積分結果爲:",g0)' ) n, s
  write( *,'(1x,"精確積分爲:",g0)' ) 1.02d0**(-10.d0) - 1.d0
End program main