高斯牛頓法求解最小二乘問題

!// 本代碼原理以及測試數據來自wiki: https://en.wikipedia.org/wiki/Gauss%E2%80%93Newton_algorithm#Example
Module varGS
  Implicit None
  !//Nparas爲參數個數，ndata爲數據個數，Niters爲最大迭代次數
  Integer, parameter :: Nparas = 2, ndata = 7, Niters = 50, Fileid = 101
  !//xobs爲觀測數據自變量，yobs爲觀測數據因變量，兩者均爲已知數據
  Real(kind=8), parameter :: xobs(ndata) = [0.038d0, 0.194d0, 0.425d0, 0.626d0, 1.253d0, 2.500d0, 3.740d0]
  Real(kind=8), parameter :: yobs(ndata) = [0.050d0, 0.127d0, 0.094d0, 0.2122d0, 0.2729d0, 0.2665d0, 0.3317d0]   
Contains
  Subroutine calGS( )
    Include 'link_fnl_shared.h'
    use LINRG_INT
    Implicit none
    !//循環變量，it爲迭代次數循環變量
    Integer :: it, i
    !//aInit與bInit分別爲參數猜測初始值
    Real(kind=8), parameter :: aInit = 0.1, bInit = 0.1, eps = 1d-8
    !//yest爲估計值，d爲估計值和實際值yobs之間的殘差，dT爲數組d的變形，delta爲增量矩陣
    Real(kind=8) :: yest(ndata) = 0., d(ndata) = 0., dT(ndata,1) = 0., delta(Nparas,1) = 0.0
    !//J爲雅可比矩陣，JT爲J的轉置矩陣
    Real(kind=8) :: J(ndata,Nparas) = 0., JT(Nparas,ndata) = 0.
    !//Inv_H爲H的逆矩陣，H爲海森矩陣
    Real(kind=8) :: H(Nparas,Nparas) = 0., Inv_H(Nparas,Nparas) = 0.
    !//aest，best分別爲反演參數
    Real(kind=8) :: aest = 0.,best = 0.
    Real(kind=8) :: atmp, btmp, tmp
      
    aest = aInit
    best = bInit

    Write(*,"('------------------------------------------------')") 
    Do it = 1, Niters
      yest = aest * xobs / ( best + xobs ) !//根據當前aest，best及xobs，得到函數值yest
      d = yobs - yest   !//計算已知值yobs與yest的殘差
      
      Do i = 1, ndata  !//計算雅可比矩陣。dy/da = x / ( b + x )，dy/db = -a*x / ( b + x )**2
        J(i,1) = xobs(i) / ( best + xobs(i) )
        J(i,2) = -aest * xobs(i) / ( best + xobs(i) )**2
      End do
      
      JT = transpose(J)   
      H = matmul( JT,J )  !//計算海森矩陣
    
      !// 計算步長delta，並根據步長計算新的參數估計值
      call LINRG( H,Inv_H )   !//使用imsl函數庫，計算H的逆矩陣Inv_H。或者調用mkl函數庫的gesv。
      !// 或者自己寫。本人在第二章已寫，懶得調用了
    
      dT = reshape( d,[ndata,1] )  !//爲了滿足內部函數Matmul的計算法則，對d的數組形狀進行改變
      delta = matmul( matmul( Inv_H,JT ),dT )  !//delta爲增量
      atmp = aest + delta(1,1)
      btmp = best + delta(2,1)
    
      !//如果||delta||<1e-8，終止迭代。也可以用前一次與後一次的aest與best的差來做條件
      If ( dot_product(delta(:,1),delta(:,1))<eps ) exit  
      aest = atmp
      best = btmp
    
      Write(*,"('aest =',f10.6,2x,'best =',f10.6)") aest, best
    End Do
    Write(*,"('------------------------------------------------')") 
    Write(*,"('停止迭代，總共迭代',g0,'次')") it - 1
    !//輸出正反演數據以及百分比誤差輸出到文件,總共100個數據點,計算區域爲[0-50]
    Open(Fileid,file='fitdat.dat',status='unknown')
    Do i = 0, 100
      tmp = dble(i) / 20.d0
      Write( fileid,'(2f12.8)') tmp, aest * tmp / ( best + tmp )
    End Do
    Close( fileid )
    !//輸出反演參數aest，best
    Write(*,"(/,'反演參數爲：')")
    Write(*,"('a_est =',f10.6)") aest
    Write(*,"('b_est =',f10.6)") best
  End subroutine calGS
End Module varGS
  

Program GaussNewton
  use varGS
  Implicit None
  call calGS( )
End Program GaussNewton