高斯積分

!// 注: 參考來源http://fcode.cn/algorithm-73-1.html  
Module Gauss_Legendre !//高斯—勒讓德積分高斯點及權重的求解模塊
  Implicit none
  Integer, parameter :: n  = 11                          !// 設置求解高斯點的個數
  Integer, parameter :: DP = selected_real_kind( p=13 )  !// 設置kind的數值
  Real(kind=DP), parameter :: eps = 1.0e-15_DP           !// 精度設置
Contains
  Real(Kind=DP) function N_Legendre(x) !// 生成n階勒讓德多項式
    Implicit none
    Integer :: i
    Real(Kind=DP) :: a(n), x
    a(1) = x !// 1階勒讓德多項式
    a(2) = 1.5_DP*x*x - 0.5_DP !// 2階勒讓德多項式
    Do i = 3, n
      a(i) = ( dble(i+i-1)*x*a(i-1) - dble(i-1)*a(i-2) ) / dble(i) !// 利用遞推關係產生n階勒讓德多項式
    End do
    N_Legendre=a(n) !//生成的n階勒讓德多項式
  End function N_Legendre

  Real(Kind=DP) Function N1_Legendre(x)  !// 生成n-1階勒讓德多項式 
    Implicit none
    Integer :: i
    Real (Kind=DP) :: a(n), x
    a(1) = x
    a(2) = 1.5_DP*x**2 - 0.5_DP
    Do i = 3, n - 1
      a(i) = (2*i-1)*x*a(i-1)/i - (i-1)*a(i-2)/i
    End Do
    N1_Legendre = a(n-1)     
  End function N1_Legendre
  
  Real(Kind=DP) function DN_Legendre(x)  !// 生成n階勒讓德多項式的導數表達式
    Implicit none
    Integer :: i
    Real(Kind=DP) :: a(n), x
    a(1) = x  !// 1階勒讓德多項式
    a(2) = 1.5_DP*x*x - 0.5_DP !// 2階勒讓德多項式
    Do i = 3, n
      a(i) = ( dble(i+i-1)*x*a(i-1) - dble(i-1)*a(i-2) ) / dble(i) !// 利用遞推關係產生n階勒讓德多項式
    End Do
    DN_Legendre = ( a(n-1) - x*a(n) )*dble(n) / (1.0_DP - x*x ) 
  End function DN_Legendre

  Real(Kind=DP) function NewtonIteration(a, b) !// 牛頓法求解函數的解
    Implicit none
    Integer :: i
    Real(Kind=DP) :: a, b, x, xtmp
    Integer, parameter :: nloop = 2000
    !// a,b是傳遞進來的劃分好的有一個解存在的區間
    x = ( a + b ) / 2.d0  !// 初始估計值
    i = 0
    Do 
      xtmp = x - N_Legendre(x) / DN_Legendre(x)   !// X(i+1) = Xi - f(Xi) / f'(Xi)  i = 1,2,...N
      i = i + 1
      If ( abs( xtmp-x ) < eps .and. i > nloop ) exit
      x = xtmp
    End do 
    NewtonIteration = x
  End function NewtonIteration
  Subroutine root_coeff ( f_root, f_coeff )  !// 計算N階勒讓德多項式的根與去做權重係數
    Implicit none
    Real(Kind=DP) :: m, nstep, f_root(n), f_coeff(n) !// 定義數組,大小n由module開始聲明。
    Integer :: i, j
    Real(kind=DP), parameter :: h = 1.d-6
    j = 0   !// 賦值控制循環變量的初值           
    m = -1.d0 - h   !// 設置計算域[-1，1] 的下限，即代替-1 
    nstep = nint(2.d0/h)
    Do i = 1, nstep   !// 這個循環次數應該是由步長0.000001決 定,計算方法：2000000=2/0.000001     
      If ( N_Legendre(m)*N_Legendre(m+h) < 0 ) then   !// 從下限處開始往上逐步累加
        j = j + 1    !// 記錄這是第幾個解
        f_root(j) = NewtonIteration( m, m+h )!// 調用牛頓法求解程序在分好的一小段上求解，將解存儲在fn（j）
        f_coeff(j) = 2.0_DP / ( dble(n) * N1_Legendre(f_root(j)) * DN_Legendre(f_root(j)) ) !// 利用公式計算高斯點的權重
        write (*,'(1x,a,g0)') '高斯點序號: ', j
        write (*,'(1x,a,g0,2x,a,g0)') '高斯點: ', f_root(j), '高斯點權重', f_coeff(j)
        write(*,'(1x,a)') '------------------------------------------------------'
      End if
      m = m + h !// 執行完一次判斷m向前推進一步
    End Do
  End subroutine root_coeff
  
  Real(Kind=DP) function func(x) !// 被積函數
    Implicit none
    Real(Kind=DP) :: x
    func = exp( -x*x/2.0_DP ) !// 每次計算在這裏修改被積函數即可
  End function func
End module Gauss_Legendre
Program GaussianIntegral
  use Gauss_Legendre
  Implicit none
  Real (Kind=DP) :: f_root(n), f_coeff(n), x, a, b, answer
  Integer :: i
  Call root_coeff ( f_root, f_coeff ) !// 調用求高斯零點和權重的子函數
  a = -1.0_DP !// 積分上限
  b = 1.0_DP !// 積分下限   
  answer = 0.d0 !// 求積分結果賦初始值
  !// 一般區間[a,b]上的積分公式
  !// Integral[f(x),a,b] = Integral[f( ((b-a)*t+b+a)/2 )] * ( b-a )/2. t爲N階勒讓德多項式的根
  Do i = 1, n
    answer = answer + f_coeff(i) * func( (a+b) / 2.0_DP + (b-a) / 2.0_DP * f_root(i) ) !// 高斯勒讓德求積分公式     
  End Do
  answer = answer * (b-a) / 2.0_DP
  !// 精確解爲1.71124878378430
  !// 數值解爲1.711248783784299  
  Write(*,'(1x,a,g0)') '高斯-勒讓德求積分結果: ', answer
End program GaussianIntegral