Class Assimilation
In: assimilation.f90

データ同化に必要となるルーチン集

Methods

Included Modules

statistics max_min

Public Instance methods

Subroutine :
x(:) :real, intent(in)
: 内挿点での座標値[直交座標系]
fg(size(x)) :real, intent(in)
: 内挿点での第一推定値
obs_posi(:) :real, intent(in)
: 観測点の座標値[x 系での値]
obs(size(obs_posi)) :real, intent(in)
: 観測点での観測値
method :character(1), intent(in)
: 影響球の形 ‘B’ : Barnes (1964) によるガウシアン球 ‘C’ : Cressman (1959) による有限球
inter_val(size(x)) :real, intent(inout)
: 内挿された値
rad :real, intent(in), optional
: 影響球の半径[x 系での値] デフォルトは各格子点からの最近の観測点を 計算し, その最遠距離を設定.
hx(size(x)) :real, intent(in), optional
: x 系におけるスケール因子. デフォルトはデカルト座標系として計算.
hobs(size(obs_posi)) :real, intent(in), optional
: 観測点で定義された x 系におけるスケール因子. デフォルトはデカルト座標系として計算.
lambda :real, intent(in), optional
: 観測誤差標準偏差 / 背景誤差標準偏差 デフォルトではゼロ.
 real, intent(in), optional :: undef  ! 観測の欠損値[第一推定値には欠損がない]

, undef ) 1 次元データについて, 逐次修正法による内挿を行う. ここで, 第一推定値から観測点への内挿は線形内挿を行うものとする. 第一推定値をゼロとすれば, 純粋な逐次内挿が行われる. つまり, 観測値のみから推定した内挿が行える.

[Source]

subroutine successive_modif_1d( x, fg, obs_posi, obs, method, inter_val, rad, hx, hobs, lambda )!, undef )
! 1 次元データについて, 逐次修正法による内挿を行う.
! ここで, 第一推定値から観測点への内挿は線形内挿を行うものとする.
! 第一推定値をゼロとすれば, 純粋な逐次内挿が行われる.
! つまり, 観測値のみから推定した内挿が行える.
  use statistics
  use max_min
  implicit none
  real, intent(in) :: x(:)  ! 内挿点での座標値[直交座標系]
  real, intent(in) :: fg(size(x))  ! 内挿点での第一推定値
  real, intent(in) :: obs_posi(:)  ! 観測点の座標値[x 系での値]
  real, intent(in) :: obs(size(obs_posi))  ! 観測点での観測値
  character(1), intent(in) :: method  ! 影響球の形
                              ! 'B' : Barnes (1964) によるガウシアン球
                              ! 'C' : Cressman (1959) による有限球
  real, intent(inout) :: inter_val(size(x))  ! 内挿された値
  real, intent(in), optional :: rad  ! 影響球の半径[x 系での値]
                                     ! デフォルトは各格子点からの最近の観測点を
                                     ! 計算し, その最遠距離を設定.
  real, intent(in), optional :: hx(size(x))  ! x 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: hobs(size(obs_posi))  ! 観測点で定義された x 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: lambda  ! 観測誤差標準偏差 / 背景誤差標準偏差
                                       ! デフォルトではゼロ.
!  real, intent(in), optional :: undef  ! 観測の欠損値[第一推定値には欠損がない]
  integer :: nx, i, j, k, nob, obs_i
  real :: lam
  real :: wei(size(x),size(obs_posi)), interp(size(obs_posi))
  real :: radius(size(x),size(obs_posi)), geo_fg(size(x)), fg2obs(size(x))
  real :: geo_obs(size(obs_posi))
  real :: sphe_rad

!-- undef 対応のため, undef が入っている観測点は
  nx=size(x)
  nob=size(obs_posi)

  if(present(lambda))then
     lam=lambda
  else
     lam=0.0
  end if

!-- スケール因子が入力されている場合, 幾何的直交座標系に落とす.
  if(present(hx).and.present(hobs))then
     do i=1,nx
        geo_fg(i)=hx(i)*x(i)
     end do
     do k=1,nob
        geo_obs(i)=hobs(i)*obs_posi(i)
     end do
  else
     if(present(hx).or.present(hobs))then  ! どちらかしかない場合, エラーとなる.
        write(*,*) "#### ERROR ####"
        write(*,*) "hx 'and' hobs must be set. STOP"
        stop
     else
        do i=1,nx
           geo_fg(i)=x(i)
        end do
        do k=1,nob
           geo_obs(i)=obs_posi(i)
        end do
     end if
  end if

!-- rad が指定されていない場合の, 半径の計算
!-- 各格子点での最近接観測点までの距離で, 最遠となる値.
  if(present(rad))then
     sphe_rad=rad
  else
     do i=1,nx
        call nearest_search_1d( geo_obs, geo_fg(i), obs_i )
        fg2obs(i)=abs(geo_obs(obs_i)-geo_fg(i))
     end do
     call max_val_1d( fg2obs, obs_i, sphe_rad)
  end if

!-- 第一推定値を用いて, 観測点すべてに第一推定値の線形内挿を行う.
  do k=1,nob
     call interpo_search_1d( x, obs_posi(k), fg_interp )
     call interpolation_1d( x(fg_interp:fg_interp+1), fg(fg_interp:fg_interp+1), obs_posi(k), interp(k) )
  end do

!-- 各第一推定値格子点から, 全観測点までの直線距離を計算する.
  do k=1,nob
     do i=1,nx
        radius(i,k)=sqrt((geo_fg(i)-geo_obs(k))*(geo_fg(i)-geo_obs(k)))
     end do
  end do

!-- 重み関数の計算
  select case(method)
  case('B')  ! Barnes 法
     do k=1,nob
        do i=1,nx
           wei(i,k)=exp(-(radius(i,k))/(sphe_rad))
        end do
     end do
  case('C')  ! Cressman 法
     do k=1,nob
        do i=1,nx
           if(radius(i,j)<rad)then
              wei(i,k)=(sphe_rad**2-radius(i,k)**2)/(sphe_rad**2+radius(i,k)**2)
           else
              wei(i,k)=0.0
           end if
        end do
     end do
  case default
     write(*,*) "#### ERROR ####"
     write(*,*) "method is not specified or, wrong. STOP"
     stop
  end select

!-- 修正項の計算
  do i=1,nx
     summ(i)=0.0
     summ_wei(i)=0.0
     do k=1,nob
        if(wei(i,j)/=0.0)then
           summ(i)=summ(i)+wei(i,k)*(obs(k)-intep(k))
           summ_wei(i)=summ_wei(i)+wei(i,k)
        end do
     end do
  end do

  do i=1,nx
     inter_val(i)=fg(i)+(summ(i))/(summ_wei(i)+lam**2)
  end do

end subroutine successive_modif_1d
Subroutine :
x(:) :real, intent(in)
: 内挿点での第 1 座標値[直交座標系]
y(:) :real, intent(in)
: 内挿点での第 2 座標値[直交座標系]
fg(size(x),size(y)) :real, intent(in)
: 内挿点での第一推定値
obs_posix(:) :real, intent(in)
: 観測点の座標値[x 系での値]
obs_posiy(:) :real, intent(in)
: 観測点の座標値[y 系での値]
obs(size(obs_posix),size(obs_posiy)) :real, intent(in)
: 観測点での観測値
method :character(1), intent(in)
: 影響球の形 ‘B’ : Barnes (1964) によるガウシアン球 ‘C’ : Cressman (1959) による有限球
inter_val(size(x),size(y)) :real, intent(inout)
: 内挿された値
rad :real, intent(in), optional
: 影響球の半径[x 系での値] デフォルトは各格子点からの最近の観測点を 計算し, その最遠距離を設定.
hx(size(x)) :real, intent(in), optional
: x 系におけるスケール因子. デフォルトはデカルト座標系として計算.
hy(size(y)) :real, intent(in), optional
: y 系におけるスケール因子. デフォルトはデカルト座標系として計算.
hobsx(size(obs_posix)) :real, intent(in), optional
: 観測点で定義された x 系におけるスケール因子. デフォルトはデカルト座標系として計算.
hobsy(size(obs_posiy)) :real, intent(in), optional
: 観測点で定義された y 系におけるスケール因子. デフォルトはデカルト座標系として計算.
lambda :real, intent(in), optional
: 観測誤差標準偏差 / 背景誤差標準偏差 デフォルトではゼロ.
 real, intent(in), optional :: undef  ! 観測の欠損値[第一推定値には欠損がない]

, undef ) 2 次元データについて, 逐次修正法による内挿を行う. ここで, 第一推定値から観測点への内挿は線形内挿を行うものとする. 第一推定値をゼロとすれば, 純粋な逐次内挿が行われる. つまり, 観測値のみから推定した内挿が行える.

[Source]

subroutine successive_modif_2d( x, y, fg, obs_posix, obs_posiy, obs, method, inter_val, rad, hx, hy, hobsx, hobsy, lambda )!, undef )
! 2 次元データについて, 逐次修正法による内挿を行う.
! ここで, 第一推定値から観測点への内挿は線形内挿を行うものとする.
! 第一推定値をゼロとすれば, 純粋な逐次内挿が行われる.
! つまり, 観測値のみから推定した内挿が行える.
  use statistics
  use max_min
!作成途中
  implicit none
  real, intent(in) :: x(:)  ! 内挿点での第 1 座標値[直交座標系]
  real, intent(in) :: y(:)  ! 内挿点での第 2 座標値[直交座標系]
  real, intent(in) :: fg(size(x),size(y))  ! 内挿点での第一推定値
  real, intent(in) :: obs_posix(:)  ! 観測点の座標値[x 系での値]
  real, intent(in) :: obs_posiy(:)  ! 観測点の座標値[y 系での値]
  real, intent(in) :: obs(size(obs_posix),size(obs_posiy))  ! 観測点での観測値
  character(1), intent(in) :: method  ! 影響球の形
                              ! 'B' : Barnes (1964) によるガウシアン球
                              ! 'C' : Cressman (1959) による有限球
  real, intent(inout) :: inter_val(size(x),size(y))  ! 内挿された値
  real, intent(in), optional :: rad  ! 影響球の半径[x 系での値]
                                     ! デフォルトは各格子点からの最近の観測点を
                                     ! 計算し, その最遠距離を設定.
  real, intent(in), optional :: hx(size(x))  ! x 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: hy(size(y))  ! y 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: hobsx(size(obs_posix))  ! 観測点で定義された x 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: hobsy(size(obs_posiy))  ! 観測点で定義された y 系におけるスケール因子.
                                ! デフォルトはデカルト座標系として計算.
  real, intent(in), optional :: lambda  ! 観測誤差標準偏差 / 背景誤差標準偏差
                                       ! デフォルトではゼロ.
!  real, intent(in), optional :: undef  ! 観測の欠損値[第一推定値には欠損がない]
  integer :: nx, i, j, k, nob
  real :: lam
  real :: wei(size(x),size(obs_posi)), interp(size(obs_posi))
  real :: radius(size(x),size(obs_posi)), geo_fg(size(x))
  real :: geo_obs(size(obs_posi))
  real :: sphe_rad

!-- undef 対応のため, undef が入っている観測点は
  nx=size(x)
  nob=size(obs_posi)

  if(present(lambda))then
     lam=lambda
  else
     lam=0.0
  end if

!-- スケール因子が入力されている場合, 幾何的直交座標系に落とす.
  if(present(hx).and.present(hobs))then
     do i=1,nx
        geo_fg(i)=hx(i)*x(i)
     end do
     do k=1,nob
        geo_obs(i)=hobs(i)*obs_posi(i)
     end do
  else
     if(present(hx).or.present(hobs))then  ! どちらかしかない場合, エラーとなる.
        write(*,*) "#### ERROR ####"
        write(*,*) "hx 'and' hobs must be set. STOP"
        stop
     else
        do i=1,nx
           geo_fg(i)=x(i)
        end do
        do k=1,nob
           geo_obs(i)=obs_posi(i)
        end do
     end if
  end if

!-- rad が指定されていない場合の, 半径の計算
!-- 各格子点での最近接観測点までの距離で, 最遠となる値.
  if(present(rad))then
     sphe_rad=rad
  else
     do i=1,nx
        call nearest_search_1d( geo_obs, geo_fg(i), obs_i )
        fg2obs(i)=abs(geo_obs(obs_i)-geo_fg(i))
     end do
     call max_val_1d( fg2obs, obs_i, sphe_rad)
  end if

!-- 第一推定値を用いて, 観測点すべてに第一推定値の線形内挿を行う.
  do k=1,nob
     call interpo_search_1d( x, obs_posi(k), fg_interp )
     call interpolation_1d( x(fg_interp:fg_interp+1), fg(fg_interp:fg_interp+1), obs_posi(k), interp(k) )
  end do

!-- 各第一推定値格子点から, 全観測点までの直線距離を計算する.
  do k=1,nob
     do i=1,nx
        radius(i,k)=sqrt((geo_fg(i)-geo_obs(k))*(geo_fg(i)-geo_obs(k)))
     end do
  end do

!-- 重み関数の計算
  select case(method)
  case('B')  ! Barnes 法
     do k=1,nob
        do i=1,nx
           wei(i,k)=exp(-(radius(i,k))/(sphe_rad))
        end do
     end do
  case('C')  ! Cressman 法
     do k=1,nob
        do i=1,nx
           if(radius(i,j)<rad)then
              wei(i,k)=(sphe_rad**2-radius(i,k)**2)/(sphe_rad**2+radius(i,k)**2)
           else
              wei(i,k)=0.0
           end if
        end do
     end do
  case default
     write(*,*) "#### ERROR ####"
     write(*,*) "method is not specified or, wrong. STOP"
     stop
  end select

!-- 修正項の計算
  do i=1,nx
     summ(i)=0.0
     summ_wei(i)=0.0
     do k=1,nob
        if(wei(i,j)/=0.0)then
           summ(i)=summ(i)+wei(i,k)*(obs(k)-intep(k))
           summ_wei(i)=summ_wei(i)+wei(i,k)
        end do
     end do
  end do

  do i=1,nx
     inter_val(i)=fg(i)+(summ(i))/(summ_wei(i)+lam**2)
  end do

end subroutine successive_modif_1d