Class Statistics
In: statistics.f90

統計解析関係のルーチン集

Methods

Included Modules

Matrix_Calc

Public Instance methods

Subroutine :
x(:) :real, intent(in)
: データ
anor(size(x)) :real, intent(inout)
: 各 x(i) に対応する偏差 anor(i)
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

1 次元データ配列の偏差を返す

[Source]

subroutine Anomaly_1d( x, anor, error )  ! 1 次元データ配列の偏差を返す
  implicit none
  real, intent(in) :: x(:)  ! データ
  real, intent(inout) :: anor(size(x))  ! 各 x(i) に対応する偏差 anor(i)
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i
  integer :: nx  ! データの要素数
  real :: ave

  nx=size(x)

  if(present(error))then
     call Mean_1d( x, ave, error )
     do i=1,nx
        if(x(i)==error)then
           anor(i)=error
        else
           anor(i)=x(i)-ave
        end if
     end do
  else
     call Mean_1d( x, ave )
     do i=1,nx
        anor(i)=x(i)-ave
     end do
  end if

end subroutine Anomaly_1d
Subroutine :
x(:,:) :real, intent(in)
: データ
anor(size(x,1),size(x,2)) :real, intent(inout)
: 各 x(i,j) に対応する偏差 anor(i,j)
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

2 次元データ配列の偏差を返す

[Source]

subroutine Anomaly_2d( x, anor, error )  ! 2 次元データ配列の偏差を返す
  implicit none
  real, intent(in) :: x(:,:)  ! データ
  real, intent(inout) :: anor(size(x,1),size(x,2))  ! 各 x(i,j) に対応する偏差 anor(i,j)
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i, j
  integer :: nx  ! データの要素数 1
  integer :: ny  ! データの要素数 2
  real :: ave

  nx=size(x,1)
  ny=size(x,2)

  if(present(error))then
     call Mean_2d( x, ave, error )
     do j=1,ny
        do i=1,nx
           if(x(i,j)==error)then
              anor(i,j)=error
           else
              anor(i,j)=x(i,j)-ave
           end if
        end do
     end do
  else
     call Mean_2d( x, ave, error )
     do j=1,ny
        do i=1,nx
           anor(i,j)=x(i,j)-ave
        end do
     end do
  end if

end subroutine Anomaly_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ
anor(size(x,1),size(x,2),size(x,3)) :real, intent(inout)
: 各 x(i,j,k) に対応する偏差 anor(i,j,k)
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

3 次元データ配列の偏差を返す

[Source]

subroutine Anomaly_3d( x, anor, error )  ! 3 次元データ配列の偏差を返す
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ
  real, intent(inout) :: anor(size(x,1),size(x,2),size(x,3))  ! 各 x(i,j,k) に対応する偏差 anor(i,j,k)
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i, j, k
  integer :: nx  ! データの要素数 1
  integer :: ny  ! データの要素数 2
  integer :: nz  ! データの要素数 3
  real :: ave

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  if(present(error))then
     call Mean_3d( x, ave, error )
     do k=1,nz
        do j=1,ny
           do i=1,nx
              if(x(i,j,k)==error)then
                 anor(i,j,k)=error
              else
                 anor(i,j,k)=x(i,j,k)-ave
              end if
           end do
        end do
     end do
  else
     call Mean_3d( x, ave, error )
     do k=1,nz
        do j=1,ny
           do i=1,nx
              anor(i,j,k)=x(i,j,k)-ave
           end do
        end do
     end do
  end if

end subroutine Anomaly_3d
Bubble_Sort( a, b, sig )
Subroutine :
a(:) :integer, intent(in)
: ソートする配列
b(size(a)) :integer, intent(inout)
: ソートした結果を格納する配列
sig :character(1), intent(in)
: ソートの順番 ‘i’ = 要素番号の若いものに小さい値が入る ‘r’ = 要素番号の若いものに大きい値が入る

バブルソートを用いて数値データを sig の方向にソートする.

Alias for Bubble_Sort_i

Bubble_Sort( a, b, sig )
Subroutine :
a(:) :real, intent(in)
: ソートする配列
b(size(a)) :real, intent(inout)
: ソートした結果を格納する配列
sig :character(1), intent(in)
: ソートの順番 ‘i’ = 要素番号の若いものに小さい値が入る ‘r’ = 要素番号の若いものに大きい値が入る

バブルソートを用いて数値データを sig の方向にソートする.

Alias for Bubble_Sort_f

Subroutine :
a(:) :real, intent(in)
: ソートする配列
b(size(a)) :real, intent(inout)
: ソートした結果を格納する配列
sig :character(1), intent(in)
: ソートの順番 ‘i’ = 要素番号の若いものに小さい値が入る ‘r’ = 要素番号の若いものに大きい値が入る

バブルソートを用いて数値データを sig の方向にソートする.

[Source]

subroutine Bubble_Sort_f( a, b, sig )
! バブルソートを用いて数値データを sig の方向にソートする.
  implicit none
  real, intent(in) :: a(:)  ! ソートする配列
  real, intent(inout) :: b(size(a))  ! ソートした結果を格納する配列
  character(1), intent(in) :: sig  ! ソートの順番
                                   ! 'i' = 要素番号の若いものに小さい値が入る
                                   ! 'r' = 要素番号の若いものに大きい値が入る
  integer :: i, j, n
  real :: tmp

  n=size(a)

  if(sig/='i'.and.sig/='r')then
     write(*,*) "### ERROR ###"
     write(*,*) "sig flag is 'r' .or. 'i', STOP."
     stop
  end if

  do i=1,n
     b(i)=a(i)
  end do

  if(sig=='i')then  ! 昇べきソート
     do i=1,n
        do j=1,n-1
           if(b(j)>b(j+1))then
              tmp=b(j+1)
              b(j+1)=b(j)
              b(j)=tmp
           end if
        end do
     end do
  else
     do i=1,n
        do j=1,n-1
           if(b(j)<b(j+1))then
              tmp=b(j+1)
              b(j+1)=b(j)
              b(j)=tmp
           end if
        end do
     end do
  end if

end subroutine Bubble_Sort_f
Subroutine :
a(:) :integer, intent(in)
: ソートする配列
b(size(a)) :integer, intent(inout)
: ソートした結果を格納する配列
sig :character(1), intent(in)
: ソートの順番 ‘i’ = 要素番号の若いものに小さい値が入る ‘r’ = 要素番号の若いものに大きい値が入る

バブルソートを用いて数値データを sig の方向にソートする.

[Source]

subroutine Bubble_Sort_i( a, b, sig )
! バブルソートを用いて数値データを sig の方向にソートする.
  implicit none
  integer, intent(in) :: a(:)  ! ソートする配列
  integer, intent(inout) :: b(size(a))  ! ソートした結果を格納する配列
  character(1), intent(in) :: sig  ! ソートの順番
                                   ! 'i' = 要素番号の若いものに小さい値が入る
                                   ! 'r' = 要素番号の若いものに大きい値が入る
  integer :: i, j, n
  integer :: tmp

  n=size(a)

  if(sig/='i'.and.sig/='r')then
     write(*,*) "### ERROR ###"
     write(*,*) "sig flag is 'r' .or. 'i', STOP."
     stop
  end if

  do i=1,n
     b(i)=a(i)
  end do

  if(sig=='i')then  ! 昇べきソート
     do i=1,n
        do j=1,n-1
           if(b(j)>b(j+1))then
              tmp=b(j+1)
              b(j+1)=b(j)
              b(j)=tmp
           end if
        end do
     end do
  else
     do i=1,n
        do j=1,n-1
           if(b(j)<b(j+1))then
              tmp=b(j+1)
              b(j+1)=b(j)
              b(j)=tmp
           end if
        end do
     end do
  end if

end subroutine Bubble_Sort_i
Cor_Coe( x, y, cc, [error] )
Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
cc :real, intent(inout)
: 相関係数
error :real, intent(in), optional
: 欠損値

2 データの相関係数を計算するルーチン

Alias for Cor_Coe_1d

Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
cc :real, intent(inout)
: 相関係数
error :real, intent(in), optional
: 欠損値

2 データの相関係数を計算するルーチン

[Source]

subroutine Cor_Coe_1d( x, y ,cc, error )  ! 2 データの相関係数を計算するルーチン
  implicit none
  real, intent(in) :: x(:)  ! データ要素 1
  real, intent(in) :: y(size(x))  ! データ要素 2
  real, intent(inout) :: cc  ! 相関係数
  real, intent(in), optional :: error  ! 欠損値
  integer :: nx  ! データ個数
  real :: cov, anor1, anor2

  nx=size(x)

  if(present(error))then
     call covariance( x, y, cov, error )
     call stand_vari( x, anor1, error )
     call stand_vari( y, anor2, error )
  else
     call covariance( x, y, cov )
     call stand_vari( x, anor1 )
     call stand_vari( y, anor2 )
  end if

  cc=cov/(sqrt(anor1)*sqrt(anor2))

end subroutine Cor_Coe_1d
Subroutine :
x(:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2)) :real, intent(in)
: データ要素 2
cc :real, intent(inout)
: 相関係数
error :real, intent(in), optional
: 欠損値

2 データの相関係数を計算するルーチン (2 次元版)

[Source]

subroutine Cor_Coe_2d( x, y ,cc, error )  ! 2 データの相関係数を計算するルーチン (2 次元版)
  implicit none
  real, intent(in) :: x(:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2))  ! データ要素 2
  real, intent(inout) :: cc  ! 相関係数
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, counter
  integer :: nx  ! データ個数 1
  integer :: ny  ! データ個数 2
  real, dimension(size(x,1)*size(x,2)) :: val1, val2

  nx=size(x,1)
  ny=size(x,2)

  counter=0

  do j=1,ny
     do i=1,nx
        counter=counter+1
        val1(counter)=x(i,j)
        val2(counter)=y(i,j)
     end do
  end do

  if(present(error))then
     call Cor_Coe_1d( val1, val2, cc, error )
  else
     call Cor_Coe_1d( val1, val2, cc )
  end if

end subroutine Cor_Coe_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2),size(x,3)) :real, intent(in)
: データ要素 2
cc :real, intent(inout)
: 相関係数
error :real, intent(in), optional
: 欠損値

2 データの相関係数を計算するルーチン (3 次元版)

[Source]

subroutine Cor_Coe_3d( x, y ,cc, error )  ! 2 データの相関係数を計算するルーチン (3 次元版)
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2),size(x,3))  ! データ要素 2
  real, intent(inout) :: cc  ! 相関係数
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, k, counter
  integer :: nx  ! データ個数 1
  integer :: ny  ! データ個数 2
  integer :: nz  ! データ個数 2
  real, dimension(size(x,1)*size(x,2)*size(x,3)) :: val1, val2

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           val1(counter)=x(i,j,k)
           val2(counter)=y(i,j,k)
        end do
     end do
  end do

  if(present(error))then
     call Cor_Coe_1d( val1, val2, cc, error )
  else
     call Cor_Coe_1d( val1, val2, cc )
  end if

end subroutine Cor_Coe_3d
LSM( x, y, slope, intercept, [undef] )
Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: undef

最小二乗法による傾きと切片計算 (1 次元データ版)

Alias for LSM_1d

Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: undef

最小二乗法による傾きと切片計算 (1 次元データ版)

[Source]

subroutine LSM_1d( x, y, slope, intercept, undef )  ! 最小二乗法による傾きと切片計算 (1 次元データ版)
  implicit none
  real, intent(in) :: x(:)  ! データ要素 1
  real, intent(in) :: y(size(x))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: undef ! undef 
  real :: u(size(x)), v(size(x))
  integer :: i
  integer :: nx  ! データ数
  real :: a, b, c, d

  nx=size(x)
  a=0.0
  b=0.0
  c=0.0
  d=0.0

!$omp parallel default(shared)
!$omp do private(i)
  do i=1,nx
     u(i)=x(i)*x(i)
     v(i)=x(i)*y(i)
  end do
!$omp end do
!$omp end parallel

  if(present(undef))then
     call summ(v,a,undef)
     call summ(x,b,undef)
     call summ(y,c,undef)
     call summ(u,d,undef)
  else
     call summ(v,a)
     call summ(x,b)
     call summ(y,c)
     call summ(u,d)
  end if

  slope=(nx*a-b*c)/(nx*d-b**2)
  intercept=(c*d-a*b)/(nx*d-b**2)

end subroutine LSM_1d
Subroutine :
x(:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: undef

最小二乗法による傾きと切片計算 (2 次元データ版)

[Source]

subroutine LSM_2d( x, y, slope, intercept, undef )  ! 最小二乗法による傾きと切片計算 (2 次元データ版)
  implicit none
  real, intent(in) :: x(:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: undef ! undef 
  real :: u(size(x,1)*size(x,2)), v(size(x,1)*size(x,2))
  integer :: i, j, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2

  nx=size(x,1)
  ny=size(x,2)

  counter=0

  do j=1,ny
     do i=1,nx
        counter=counter+1
        u(counter)=x(i,j)
        v(counter)=y(i,j)
     end do
  end do

  if(present(undef))then
     call LSM_1d( u, v, slope, intercept, undef )
  else
     call LSM_1d( u, v, slope, intercept )
  end if

end subroutine LSM_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2),size(x,3)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: undef

最小二乗法による傾きと切片計算 (3 次元データ版)

[Source]

subroutine LSM_3d( x, y, slope, intercept, undef )  ! 最小二乗法による傾きと切片計算 (3 次元データ版)
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2),size(x,3))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: undef ! undef 
  real :: u(size(x,1)*size(x,2)*size(x,3)), v(size(x,1)*size(x,2)*size(x,3))
  integer :: i, j, k, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  integer :: nz  ! データ数 3

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           u(counter)=x(i,j,k)
           v(counter)=y(i,j,k)
        end do
     end do
  end do

  if(present(undef))then
     call LSM_1d( u, v, slope, intercept, undef )
  else
     call LSM_1d( u, v, slope, intercept )
  end if

end subroutine LSM_3d
LSM_poly( x, y, a, intercept, [undef] )
Subroutine :
x(:) :real, intent(in)
: データ要素配列 1
y(size(x)) :real, intent(in)
: データ要素配列 2
a(:) :real, intent(inout)
: 多項式の係数
intercept :real, intent(inout)
: y 切片. a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が あり, 紛らわしいと判断したため, a_0 である y 切片を 独立で引数として渡すことにした.
undef :real, intent(in), optional
: 未定義値.

LSM の多項式近似バージョン. LSM では, F(x)=a_0+a_1x の直線近似を行っていたが, LSM_poly では, F(x)=sum^{N}_{n=0}{a_nx^n} の任意次数の多項式曲線近似を行うことが可能. アルゴリズムは最小二乗法を用いており, 係数のソルバには gausss ルーチンを使用.

Alias for LSM_poly_1d

Subroutine :
x(:) :real, intent(in)
: データ要素配列 1
y(size(x)) :real, intent(in)
: データ要素配列 2
a(:) :real, intent(inout)
: 多項式の係数
intercept :real, intent(inout)
: y 切片. a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が あり, 紛らわしいと判断したため, a_0 である y 切片を 独立で引数として渡すことにした.
undef :real, intent(in), optional
: 未定義値.

LSM の多項式近似バージョン. LSM では, F(x)=a_0+a_1x の直線近似を行っていたが, LSM_poly では, F(x)=sum^{N}_{n=0}{a_nx^n} の任意次数の多項式曲線近似を行うことが可能. アルゴリズムは最小二乗法を用いており, 係数のソルバには gausss ルーチンを使用.

[Source]

subroutine LSM_poly_1d( x, y, a, intercept, undef )
! LSM の多項式近似バージョン.
! LSM では, F(x)=a_0+a_1x の直線近似を行っていたが,
! LSM_poly では, F(x)=\sum^{N}_{n=0}{a_nx^n}
! の任意次数の多項式曲線近似を行うことが可能.
! アルゴリズムは最小二乗法を用いており, 係数のソルバには gausss ルーチンを使用.
  use Matrix_Calc
  implicit none
  real, intent(in) :: x(:)  ! データ要素配列 1
  real, intent(in) :: y(size(x))  ! データ要素配列 2
  real, intent(inout) :: a(:)  ! 多項式の係数
  real, intent(inout) :: intercept  ! y 切片. 
                         ! a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が
                         ! あり, 紛らわしいと判断したため, a_0 である y 切片を
                         ! 独立で引数として渡すことにした.
  real, intent(in), optional :: undef  ! 未定義値.
  integer :: i, j, k
  integer :: nx  ! データの個数
  integer :: poly_n  ! 近似する曲線の最高次数. 1 なら, LSM と同じ.
  real :: coe(0:size(a)), tmpa_coe(0:size(a),0:size(a)), tmpb_coe(0:size(a))
          ! coe は a_n が入る. tmp_coe はデータの総和が入る.
          ! [注意] : 第一要素が行. 第二要素が列.
  real :: tmp(size(x))  ! べき乗計算の一時配列

  nx=size(x)
  poly_n=size(a)

!-- gausss に渡しやすいように, 用意した配列に引数を代入.
  if(present(undef))then
     do k=0,poly_n  ! 列成分の計算
        do j=0,poly_n  ! 行成分の計算. 行成分の計算が先に回ることに注意.
           if(j >= k)then  ! 行成分(j)より列成分(k)の要素数が小さい場合, 値を
                           ! まじめに計算する.
              do i=1,nx
                 if(x(i)/=undef)then
                    tmp(i)=x(i)**(j+k)
                 else
                    tmp(i)=undef
                 end if
              end do
              call summ( tmp, tmpa_coe(j,k), undef )
           else  ! 行成分(j)より列成分(k)の要素数が大きい場合, 解く係数行列が
                 ! 対称行列であることから, 値の参照代入のみ行う.
              tmpa_coe(j,k)=tmpa_coe(k,j)  ! 対称成分の代入(すでに計算済み)
           end if
        end do
     end do
     do j=0,poly_n
        do i=1,nx
           if(x(i)/=undef)then
              tmp(i)=y(i)*(x(i)**j)
           else
              tmp(i)=undef
           end if
        end do
        call summ( tmp, tmpb_coe(j), undef )
     end do
  else  ! undef 処理がないとき.
     do k=0,poly_n  ! 列成分の計算
        do j=0,poly_n  ! 行成分の計算. 行成分の計算が先に回ることに注意.
           if(j >= k)then  ! 行成分(j)より列成分(k)の要素数が小さい場合, 値を
                           ! まじめに計算する.
              do i=1,nx
                 tmp(i)=x(i)**(j+k)
              end do
              call summ( tmp, tmpa_coe(j,k), undef )
           else  ! 行成分(j)より列成分(k)の要素数が大きい場合, 解く係数行列が
                 ! 対称行列であることから, 値の参照代入のみ行う.
              tmpa_coe(j,k)=tmpa_coe(k,j)  ! 対称成分の代入(すでに計算済み)
           end if
        end do
     end do
     do j=0,poly_n
        do i=1,nx
           tmp(i)=y(i)*(x(i)**j)
        end do
        call summ( tmp, tmpb_coe(j), undef )
     end do
  end if

!  以上で係数行列に値が入った.

  call gausss( tmpa_coe(0:poly_n,0:poly_n), tmpb_coe(0:poly_n), coe(0:poly_n) )

  do i=1,poly_n
     a(i)=coe(i)
  end do
  intercept=coe(0)

end subroutine LSM_poly_1d
Subroutine :
x(:,:) :real, intent(in)
: データ要素配列 1
y(size(x,1),size(x,2)) :real, intent(in)
: データ要素配列 2
a(:) :real, intent(inout)
: 多項式の係数
intercept :real, intent(inout)
: y 切片. a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が あり, 紛らわしいと判断したため, a_0 である y 切片を 独立で引数として渡すことにした.
undef :real, intent(in), optional
: 未定義値.

LSM の多項式近似バージョン. (2 次元データ版)

[Source]

subroutine LSM_poly_2d( x, y, a, intercept, undef )
! LSM の多項式近似バージョン. (2 次元データ版)
  use Matrix_Calc
  implicit none
  real, intent(in) :: x(:,:)  ! データ要素配列 1
  real, intent(in) :: y(size(x,1),size(x,2))  ! データ要素配列 2
  real, intent(inout) :: a(:)  ! 多項式の係数
  real, intent(inout) :: intercept  ! y 切片. 
                         ! a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が
                         ! あり, 紛らわしいと判断したため, a_0 である y 切片を
                         ! 独立で引数として渡すことにした.
  real, intent(in), optional :: undef  ! 未定義値.
  integer :: i, j, counter
  integer :: nx  ! データの個数 1
  integer :: ny  ! データの個数 2
  real, dimension(size(x,1)*size(x,2)) :: val1, val2

  nx=size(x,1)
  ny=size(x,2)

  counter=0

  do j=1,ny
     do i=1,nx
        counter=counter+1
        val1(counter)=x(i,j)
        val2(counter)=y(i,j)
     end do
  end do

  if(present(undef))then
     call LSM_poly_1d( val1, val2, a, intercept, undef )
  else
     call LSM_poly_1d( val1, val2, a, intercept )
  end if

end subroutine LSM_poly_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ要素配列 1
y(size(x,1),size(x,2),size(x,3)) :real, intent(in)
: データ要素配列 2
a(:) :real, intent(inout)
: 多項式の係数
intercept :real, intent(inout)
: y 切片. a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が あり, 紛らわしいと判断したため, a_0 である y 切片を 独立で引数として渡すことにした.
undef :real, intent(in), optional
: 未定義値.

LSM の多項式近似バージョン. (3 次元データ版)

[Source]

subroutine LSM_poly_3d( x, y, a, intercept, undef )
! LSM の多項式近似バージョン. (3 次元データ版)
  use Matrix_Calc
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ要素配列 1
  real, intent(in) :: y(size(x,1),size(x,2),size(x,3))  ! データ要素配列 2
  real, intent(inout) :: a(:)  ! 多項式の係数
  real, intent(inout) :: intercept  ! y 切片. 
                         ! a に組み込むと引数を渡すとき, poly_n+1 で渡す必要が
                         ! あり, 紛らわしいと判断したため, a_0 である y 切片を
                         ! 独立で引数として渡すことにした.
  real, intent(in), optional :: undef  ! 未定義値.
  integer :: i, j, k, counter
  integer :: nx  ! データの個数 1
  integer :: ny  ! データの個数 2
  integer :: nz  ! データの個数 3
  real, dimension(size(x,1)*size(x,2)*size(x,3)) :: val1, val2

  nx=size(x,1)
  ny=size(x,2)
  ny=size(x,3)

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           val1(counter)=x(i,j,k)
           val2(counter)=y(i,j,k)
        end do
     end do
  end do

  if(present(undef))then
     call LSM_poly_1d( val1, val2, a, intercept, undef )
  else
     call LSM_poly_1d( val1, val2, a, intercept )
  end if

end subroutine LSM_poly_3d
Subroutine :
x(:) :real, intent(in)
: データ
ave :real, intent(inout)
: 計算する平均値
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

1 次元配列平均値計算ルーチン

[Source]

subroutine Mean_1d( x, ave, error )  ! 1 次元配列平均値計算ルーチン
  implicit none
  real, intent(in) :: x(:)  ! データ
  real, intent(inout) :: ave  ! 計算する平均値
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i, nt
  integer :: nx  ! データの要素数
  real :: summ

  summ=0.0
  nt=0
  nx=size(x)

  if(present(error))then
     do i=1,nx
        if(x(i)/=error)then
           summ=summ+x(i)
           nt=1+nt
        end if
     end do

     if(nt/=0)then
        ave=summ/nt
     else
        ave=error
     end if

  else

     do i=1,nx
        summ=summ+x(i)
     end do

     ave=summ/nx

  end if

end subroutine Mean_1d
Subroutine :
x(:,:) :real, intent(in)
: データ
ave :real, intent(inout)
: 計算する平均値
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

2 次元配列平均値計算ルーチン

[Source]

subroutine Mean_2d( x, ave, error )  ! 2 次元配列平均値計算ルーチン
  implicit none
  real, intent(in) :: x(:,:)  ! データ
  real, intent(inout) :: ave  ! 計算する平均値
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i, j, nt
  integer :: nx  ! データの要素数 1
  integer :: ny  ! データの要素数 2
  real :: summ

  summ=0.0
  nt=0
  nx=size(x,1)
  ny=size(x,2)

  if(present(error))then
     do j=1,ny
        do i=1,nx
           if(x(i,j)/=error)then
              summ=summ+x(i,j)
              nt=1+nt
           end if
        end do
     end do

     if(nt/=0)then
        ave=summ/nt
     else
        ave=error
     end if

  else

     do j=1,ny
        do i=1,nx
           summ=summ+x(i,j)
        end do
     end do

     ave=summ/(nx*ny)

  end if

end subroutine Mean_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ
ave :real, intent(inout)
: 計算する平均値
error :real, intent(in), optional
: 欠損値が存在するデータセットの場合の欠損値

3 次元配列平均値計算ルーチン

[Source]

subroutine Mean_3d( x, ave, error )  ! 3 次元配列平均値計算ルーチン
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ
  real, intent(inout) :: ave  ! 計算する平均値
  real, intent(in), optional :: error  ! 欠損値が存在するデータセットの場合の欠損値
  integer :: i, j, k, nt
  integer :: nx  ! データの要素数 1
  integer :: ny  ! データの要素数 2
  integer :: nz  ! データの要素数 2
  real :: summ

  summ=0.0
  nt=0
  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  if(present(error))then
     do k=1,nz
        do j=1,ny
           do i=1,nx
              if(x(i,j,k)/=error)then
                 summ=summ+x(i,j,k)
                 nt=1+nt
              end if
           end do
        end do
     end do

     if(nt/=0)then
        ave=summ/nt
     else
        ave=error
     end if

  else

     do k=1,nz
        do j=1,ny
           do i=1,nx
              summ=summ+x(i,j,k)
           end do
        end do
     end do

     ave=summ/(nx*ny*nz)

  end if

end subroutine Mean_3d
Subroutine :
x(:) :real, intent(in)
: データ
n :integer, intent(in)
: 平均をとる数
y(size(x)) :real, intent(inout)
: 平均化した後のデータ. 実際は, y(1:n-1) までの配列にはゼロが入る.
error :real, intent(in), optional
: 欠損値
offset :integer, intent(in), optional
: 移動平均を開始する要素番号. default = n

移動平均からのアノマリを計算するルーチン

[Source]

subroutine Move_anom( x, n, y, error, offset )
! 移動平均からのアノマリを計算するルーチン
  implicit none
  real, intent(in) :: x(:)  ! データ
  integer, intent(in) :: n  ! 平均をとる数
  real, intent(inout) :: y(size(x))  ! 平均化した後のデータ.
                      ! 実際は, y(1:n-1) までの配列にはゼロが入る.
  real, intent(in), optional :: error  ! 欠損値
  integer, intent(in), optional :: offset  ! 移動平均を開始する要素番号.
                      ! default = n
  integer :: nx, i, ioff
  real :: tmp, undef
  real :: bar(size(x))

  nx=size(x)
  y=0.0

  if(nx<n.or.n<2)then
     write(*,*) "### ERROR ### (Move_anom)"
     write(*,*) "x(nx) : nx must be more than n or n must be more than 2."
     write(*,*) "nx is ", nx, ", n is ", n, "."
     write(*,*) "STOP"
     stop
  end if

  if(present(offset))then
     if(offset>0)then
        ioff=offset
     else
        write(*,*) "### ERROR ### (Move_anom)"
        write(*,*) "offset must be more than 1."
        write(*,*) "STOP"
        stop
     end if
  else
     ioff=n
  end if

  if(present(error))then
     undef=error
  else
     undef=0.0
  end if

  call Move_ave( x, n, bar, error=undef, offset=ioff )

  if(ioff>2)then
     y(1:ioff-1)=0.0
     y(nx-n+ioff+1:nx)=0.0
  end if
  do i=ioff,nx-n+ioff
     y(i)=x(i)-bar(i)
  end do

end subroutine Move_anom
Subroutine :
x(:) :real, intent(in)
: データ
n :integer, intent(in)
: 平均をとる数
y(size(x)) :real, intent(inout)
: 平均化した後のデータ. 実際は, y(1:n-1) までの配列にはゼロが入る.
error :real, intent(in), optional
: 欠損値
offset :integer, intent(in), optional
: 移動平均を開始する要素番号. default = n

移動平均を計算するルーチン

[Source]

subroutine Move_ave( x, n, y, error, offset )
! 移動平均を計算するルーチン
  implicit none
  real, intent(in) :: x(:)  ! データ
  integer, intent(in) :: n  ! 平均をとる数
  real, intent(inout) :: y(size(x))  ! 平均化した後のデータ.
                      ! 実際は, y(1:n-1) までの配列にはゼロが入る.
  real, intent(in), optional :: error  ! 欠損値
  integer, intent(in), optional :: offset  ! 移動平均を開始する要素番号.
                      ! default = n
  integer :: nx, i, ioff
  real :: tmp

  nx=size(x)
  y=0.0

  if(nx<n.or.n<2)then
     write(*,*) "### ERROR ### (Move_ave)"
     write(*,*) "x(nx) : nx must be more than n or n must be more than 2."
     write(*,*) "nx is ", nx, ", n is ", n, "."
     write(*,*) "STOP"
     stop
  end if

  if(present(offset))then
     if(offset>0)then
        ioff=offset
     else
        write(*,*) "### ERROR ### (Move_ave)"
        write(*,*) "offset must be more than 1."
        write(*,*) "STOP"
        stop
     end if
  else
     ioff=n
  end if

  if(present(error))then
     call Mean_1d( x(1:n), tmp, error )
     if(ioff>2)then
        y(1:ioff-1)=0.0
        y(nx-n+ioff+1:nx)=0.0
     end if
     y(ioff)=tmp

     do i=ioff+1,nx-n+ioff
        y(i)=y(i-1)+(x(i+n-ioff)-x(i-ioff))/real(n)
     end do
  else
     call Mean_1d( x(1:n), tmp )
     if(ioff>2)then
        y(1:ioff-1)=0.0
        y(nx-n+ioff+1:nx)=0.0
     end if
     y(ioff)=tmp

     do i=ioff+1,nx-n+ioff
        y(i)=y(i-1)+(x(i+n-ioff)-x(i-ioff))/real(n)
     end do
  end if

end subroutine Move_ave
Reg_Line( x, y, slope, intercept, [undef] )
Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: 未定義値

LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン

Alias for Reg_Line_1d

Subroutine :
x(:) :real, intent(in)
: データ要素 1
y(size(x)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
undef :real, intent(in), optional
: 未定義値

LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン

[Source]

subroutine Reg_Line_1d( x, y, slope, intercept, undef )
  ! LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン
  implicit none
  real, intent(in) :: x(:)  ! データ要素 1
  real, intent(in) :: y(size(x))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: undef  ! 未定義値
  real :: u(size(x)), v(size(x))
  integer :: nx  ! データ数

  nx=size(x)

  if(present(undef))then
     call Anomaly_1d( x, u, undef )
     call Anomaly_1d( y, v, undef )
     call LSM( u, v, slope, intercept, undef )
  else
     call Anomaly_1d( x, u )
     call Anomaly_1d( y, v )
     call LSM( u, v, slope, intercept )
  end if

end subroutine Reg_Line_1d
Subroutine :
x(:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
error :real, intent(in), optional

LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (2 次元版)

[Source]

subroutine Reg_Line_2d( x, y, slope, intercept, error )
  ! LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (2 次元版)
  implicit none
  real, intent(in) :: x(:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: error
  real, dimension(size(x,1)*size(x,2)) :: u, v
  integer :: i, j, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2

  nx=size(x,1)
  ny=size(x,2)

  counter=0

  do j=1,ny
     do i=1,nx
        counter=counter+1
        u(counter)=x(i,j)
        v(counter)=y(i,j)
     end do
  end do

  if(present(error))then
     call Reg_Line_1d( u, v, slope, intercept, error )
  else
     call Reg_Line_1d( u, v, slope, intercept )
  end if

end subroutine Reg_Line_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ要素 1
y(size(x,1),size(x,2),size(x,3)) :real, intent(in)
: データ要素 2
slope :real, intent(inout)
: 最適な傾き
intercept :real, intent(inout)
: 最適な切片
error :real, intent(in), optional

LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (3 次元版)

[Source]

subroutine Reg_Line_3d( x, y, slope, intercept, error )
  ! LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (3 次元版)
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ要素 1
  real, intent(in) :: y(size(x,1),size(x,2),size(x,3))  ! データ要素 2
  real, intent(inout) :: slope  ! 最適な傾き
  real, intent(inout) :: intercept  ! 最適な切片
  real, intent(in), optional :: error
  real, dimension(size(x,1)*size(x,2)*size(x,3)) :: u, v
  integer :: i, j, k, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  integer :: nz  ! データ数 3

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           u(counter)=x(i,j,k)
           v(counter)=y(i,j,k)
        end do
     end do
  end do

  if(present(error))then
     call Reg_Line_1d( u, v, slope, intercept, error )
  else
     call Reg_Line_1d( u, v, slope, intercept )
  end if

end subroutine Reg_Line_3d
Subroutine :
x(:) :real, intent(in)
: 元座標
r(:) :real, intent(in)
: 内挿座標
u(size(x)) :real, intent(in)
: 元データ
v(size(r)) :real, intent(inout)
: 内挿したデータ
undef :integer, intent(in), optional
: 未定義値
undefr :real, intent(in), optional
: 内挿領域内での未定義値. 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする.

座標 x で定義されているデータ u を 座標 r で定義されるデータ v に自動で内挿する.

[Source]

subroutine auto_interpolation_1d( x, r, u, v, undef, undefr, stdopt )
  ! 座標 x で定義されているデータ u を
  ! 座標 r で定義されるデータ v に自動で内挿する.
  implicit none
  real, intent(in) :: x(:)  ! 元座標
  real, intent(in) :: r(:)  ! 内挿座標
  real, intent(in) :: u(size(x))  ! 元データ
  real, intent(inout) :: v(size(r))  ! 内挿したデータ
  integer, intent(in), optional :: undef  ! 未定義値
  real, intent(in), optional :: undefr  ! 内挿領域内での未定義値.
        ! 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
  integer :: i, nx, nr, ir
  integer :: defun
  real :: rdefun
  logical :: stderr

  nx=size(x)
  nr=size(r)

  if(present(undef))then
     defun=undef
  else
     defun=-2147483648
  end if

  if(present(undefr))then
     rdefun=undefr
  else
     rdefun=-999.0
  end if

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  do i=1, nr
     call interpo_search_1d( x, r(i), ir, int(defun), stdopt=stderr )

     if(ir/=int(defun))then
        if(ir<nx)then
           if(u(ir)/=rdefun.and.u(ir+1)/=rdefun)then
              call interpolation_1d( x(ir:ir+1), u(ir:ir+1), r(i), v(i) )
           else
              v(i)=rdefun
           end if
        else if(ir==nx.and.x(nx)==r(i))then
           v(i)=u(ir)
        else
           v(i)=real(defun)
        end if
     else
        v(i)=real(defun)
     end if
  end do

end subroutine auto_interpolation_1d
Subroutine :
x(:) :real, intent(in)
: 元座標 1
y(:) :real, intent(in)
: 元座標 2
r(:) :real, intent(in)
: 内挿座標 1
q(:) :real, intent(in)
: 内挿座標 2
u(size(x),size(y)) :real, intent(in)
: 元データ
v(size(r),size(q)) :real, intent(inout)
: 内挿したデータ
undef :integer, intent(in), optional
: 未定義値
undefr :real, intent(in), optional
: 内挿領域内での未定義値. 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする.

座標 x, y で定義されているデータ u を 座標 r, q で定義されるデータ v に自動で内挿する.

[Source]

subroutine auto_interpolation_2d( x, y, r, q, u, v, undef, undefr, stdopt )
  ! 座標 x, y で定義されているデータ u を
  ! 座標 r, q で定義されるデータ v に自動で内挿する.
  implicit none
  real, intent(in) :: x(:)  ! 元座標 1
  real, intent(in) :: y(:)  ! 元座標 2
  real, intent(in) :: r(:)  ! 内挿座標 1
  real, intent(in) :: q(:)  ! 内挿座標 2
  real, intent(in) :: u(size(x),size(y))  ! 元データ
  real, intent(inout) :: v(size(r),size(q))  ! 内挿したデータ
  integer, intent(in), optional :: undef  ! 未定義値
  real, intent(in), optional :: undefr  ! 内挿領域内での未定義値.
        ! 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
  integer :: i, j, nx, ny, nr, nq, ir, iq
  integer :: defun
  real :: rdefun
  logical :: stderr

  nx=size(x)
  ny=size(y)
  nr=size(r)
  nq=size(q)

  if(present(undef))then
     defun=undef
  else
     defun=-2147483648
  end if

  if(present(undefr))then
     rdefun=undefr
  else
     rdefun=-999.0
  end if

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  do j=1, nq
     do i=1, nr
        call interpo_search_2d( x, y, r(i), q(j), ir, iq, int(defun), stdopt=stderr )

        if(ir/=int(defun).and.iq/=int(defun))then
           if(u(ir,iq)/=rdefun)then
              if(ir<nx.and.iq<ny)then
                 if(u(ir,iq+1)/=rdefun.and.u(ir+1,iq+1)/=rdefun.and. u(ir+1,iq+1)/=rdefun)then
                    call interpolation_2d( x(ir:ir+1), y(iq:iq+1), u(ir:ir+1,iq:iq+1), (/r(i), q(j)/), v(i,j) )
                 else
                    v(i,j)=rdefun
                 end if

              else if(x(nx)==r(i).and.y(ny)==q(j))then
                 v(i,j)=u(nx,ny)

              else if(x(nx)==r(i).and.iq<ny)then
                 if(u(nx,iq+1)/=rdefun)then
                    call interpolation_1d( y(iq:iq+1), u(nx,iq:iq+1), q(j), v(i,j) )
                 else
                    v(i,j)=rdefun
                 end if

              else if(y(ny)==q(j).and.ir<nx)then
                 if(u(ir+1,ny)/=rdefun)then
                    call interpolation_1d( x(ir:ir+1), u(ir:ir+1,ny), r(i), v(i,j) )
                 else
                    v(i,j)=rdefun
                 end if
              else
write(*,*) "kokonihakonaihazu1", x(nx), r(i), y(ny), q(j), ir, nx, iq, ny
                 v(i,j)=real(defun)
              end if
           else
              v(i,j)=rdefun
           end if
        else
write(*,*) "kokonihakonaihazu2", x(nx), r(i), y(ny), q(j), ir, nx, iq, ny
           v(i,j)=real(defun)
        end if
     end do
  end do

end subroutine auto_interpolation_2d
Subroutine :
x(:) :real, intent(in)
: 元座標 1
y(:) :real, intent(in)
: 元座標 2
z(:) :real, intent(in)
: 元座標 3
r(:) :real, intent(in)
: 内挿座標 1
q(:) :real, intent(in)
: 内挿座標 2
p(:) :real, intent(in)
: 内挿座標 3
u(size(x),size(y),size(z)) :real, intent(in)
: 元データ
v(size(r),size(q),size(p)) :real, intent(inout)
: 内挿したデータ
undef :integer, intent(in), optional
: 未定義値
undefr :real, intent(in), optional
: 内挿領域内での未定義値. 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする.

座標 x, y, z で定義されているデータ u を 座標 r, q, p で定義されるデータ v に自動で内挿する.

[Source]

subroutine auto_interpolation_3d( x, y, z, r, q, p, u, v, undef, undefr, stdopt )
  ! 座標 x, y, z で定義されているデータ u を
  ! 座標 r, q, p で定義されるデータ v に自動で内挿する.
  implicit none
  real, intent(in) :: x(:)  ! 元座標 1
  real, intent(in) :: y(:)  ! 元座標 2
  real, intent(in) :: z(:)  ! 元座標 3
  real, intent(in) :: r(:)  ! 内挿座標 1
  real, intent(in) :: q(:)  ! 内挿座標 2
  real, intent(in) :: p(:)  ! 内挿座標 3
  real, intent(in) :: u(size(x),size(y),size(z))  ! 元データ
  real, intent(inout) :: v(size(r),size(q),size(p))  ! 内挿したデータ
  integer, intent(in), optional :: undef  ! 未定義値
  real, intent(in), optional :: undefr  ! 内挿領域内での未定義値.
        ! 内挿点の隣接点が undefr なら, 内挿点も undefr が代入される
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
  integer :: i, j, k, nx, ny, nz, nr, nq, np, ir, iq, ip
  integer :: defun
  real :: rdefun
  logical :: stderr

  nx=size(x)
  ny=size(y)
  nz=size(z)
  nr=size(r)
  nq=size(q)
  np=size(p)

  if(present(undef))then
     defun=undef
  else
     defun=-2147483648
  end if

  if(present(undefr))then
     rdefun=undefr
  else
     rdefun=-999.0
  end if

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  do k=1, np
     do j=1, nq
        do i=1, nr
           call interpo_search_3d( x, y, z, r(i), q(j), p(k), ir, iq, ip, int(defun), stdopt=stderr )

           if(ir/=int(defun).and.iq/=int(defun).and.ip/=int(defun))then
              if(u(ir,iq,ip)/=rdefun)then
                 if(ir<nx.and.iq<ny.and.ip<nz)then
                    if(u(ir+1,iq,ip)/=rdefun.and. u(ir,iq+1,ip)/=rdefun.and. u(ir+1,iq+1,ip)/=rdefun.and. u(ir,iq,ip+1)/=rdefun.and. u(ir+1,iq,ip+1)/=rdefun.and. u(ir,iq+1,ip+1)/=rdefun.and. u(ir+1,iq+1,ip+1)/=rdefun)then
                       call interpolation_3d( x(ir:ir+1), y(iq:iq+1), z(ip:ip+1), u(ir:ir+1,iq:iq+1,ip:ip+1), (/r(i), q(j), p(k)/), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(x(nx)==r(i).and.y(ny)==q(j).and.z(nz)==p(k))then
                    v(i,j,k)=u(ir,iq,ip)

                 else if(x(nx)==r(i).and.iq<ny.and.ip<nz)then
                    if(u(nx,iq+1,ip)/=rdefun.and.u(nx,iq,ip+1)/=rdefun.and. u(nx,iq+1,ip+1)/=rdefun)then
                       call interpolation_2d( y(iq:iq+1), z(ip:ip+1), u(nx,iq:iq+1,ip:ip+1), (/q(j), p(k)/), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(y(ny)==q(j).and.ir<nx.and.ip<nz)then
                    if(u(ir+1,ny,ip)/=rdefun.and.u(ir,ny,ip+1)/=rdefun.and. u(ir+1,ny,ip+1)/=rdefun)then
                       call interpolation_2d( x(ir:ir+1), z(ip:ip+1), u(ir:ir+1,ny,ip:ip+1), (/r(i), p(k)/), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(z(nz)==p(k).and.ir<nx.and.iq<ny)then
                    if(u(ir+1,iq,nz)/=rdefun.and.u(ir,iq+1,nz)/=rdefun.and. u(ir+1,iq+1,nz)/=rdefun)then
                       call interpolation_2d( x(ir:ir+1), y(iq:iq+1), u(ir:ir+1,iq:iq+1,nz), (/r(i), q(j)/), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(x(nx)==r(i).and.y(ny)==q(j).and.ip<nz)then
                    if(u(nx,ny,ip+1)/=rdefun)then
                       call interpolation_1d( z(ip:ip+1), u(nx,ny,ip:ip+1), p(k), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(x(nx)==r(i).and.z(nz)==p(k).and.iq<ny)then
                    if(u(nx,iq+1,nz)/=rdefun)then
                       call interpolation_1d( y(iq:iq+1), u(nx,iq:iq+1,nz), q(j), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else if(y(ny)==q(j).and.z(nz)==p(k).and.ir<nx)then
                    if(u(ir+1,ny,nz)/=rdefun)then
                       call interpolation_1d( x(ir:ir+1), u(ir:ir+1,ny,nz), r(i), v(i,j,k) )
                    else
                       v(i,j,k)=rdefun
                    end if

                 else
                    v(i,j,k)=real(defun)
                 end if
              else
                 v(i,j,k)=rdefun
              end if
           else
              v(i,j,k)=real(defun)
           end if
        end do
     end do
  end do

end subroutine auto_interpolation_3d
covariance( x, y, cov, [error] )
Subroutine :
x(:) :real, intent(in)
: データ 1
y(size(x)) :real, intent(in)
: データ 2
cov :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

2 つの 1 次元データの共分散を計算 共分散$sigma $の定義は, $$sigma =sum^{nx}_{i=1}{(x-\bar{x})(y-\bar{y})} $$

Alias for covariance_1d

Subroutine :
x(:) :real, intent(in)
: データ 1
y(size(x)) :real, intent(in)
: データ 2
cov :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

2 つの 1 次元データの共分散を計算 共分散$sigma $の定義は, $$sigma =sum^{nx}_{i=1}{(x-\bar{x})(y-\bar{y})} $$

[Source]

subroutine covariance_1d( x, y, cov, error )  ! 2 つの 1 次元データの共分散を計算
  ! 共分散$\sigma $の定義は,
  ! $$\sigma =\sum^{nx}_{i=1}{(x-\bar{x})(y-\bar{y})} $$
  implicit none
  real, intent(in) :: x(:)  ! データ 1
  real, intent(in) :: y(size(x))  ! データ 2
  real, intent(inout) :: cov  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i
  integer :: nx  ! データ数
  real :: an1(size(x)), an2(size(x))

  nx=size(x)
  cov=0.0

  if(present(error))then
     call Anomaly_1d( x, an1, error )
     call Anomaly_1d( y, an2, error )
     do i=1,nx
        if(x(i)/=error)then
           cov=cov+an1(i)*an2(i)
        end if
     end do
  else
     call Anomaly_1d( x, an1 )
     call Anomaly_1d( y, an2 )
     do i=1,nx
        cov=cov+an1(i)*an2(i)
     end do
  end if

end subroutine covariance_1d
Subroutine :
x(:,:) :real, intent(in)
: データ 1
y(size(x,1),size(x,2)) :real, intent(in)
: データ 2
cov :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

2 つの 2 次元データの共分散を計算

[Source]

subroutine covariance_2d( x, y, cov, error )  ! 2 つの 2 次元データの共分散を計算
  implicit none
  real, intent(in) :: x(:,:)  ! データ 1
  real, intent(in) :: y(size(x,1),size(x,2))  ! データ 2
  real, intent(inout) :: cov  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  real :: val1(size(x,1)*size(x,2)), val2(size(x,1)*size(x,2))

  nx=size(x,1)
  ny=size(x,2)

  counter=0

  do j=1,ny
     do i=1,nx
        counter=counter+1
        val1(counter)=x(i,j)
        val2(counter)=y(i,j)
     end do
  end do

  cov=0.0

  if(present(error))then
     call covariance_1d( val1, val2, cov, error )
  else
     call covariance_1d( val1, val2, cov )
  end if

end subroutine covariance_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ 1
y(size(x,1),size(x,2),size(x,3)) :real, intent(in)
: データ 2
cov :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

2 つの 3 次元データの共分散を計算

[Source]

subroutine covariance_3d( x, y, cov, error )  ! 2 つの 3 次元データの共分散を計算
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ 1
  real, intent(in) :: y(size(x,1),size(x,2),size(x,3))  ! データ 2
  real, intent(inout) :: cov  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, k, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  integer :: nz  ! データ数 3
  real :: val1(size(x,1)*size(x,2)*size(x,3)), val2(size(x,1)*size(x,2)*size(x,3))

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           val1(counter)=x(i,j,k)
           val2(counter)=y(i,j,k)
        end do
     end do
  end do

  cov=0.0

  if(present(error))then
     call covariance_1d( val1, val2, cov, error )
  else
     call covariance_1d( val1, val2, cov )
  end if

end subroutine covariance_3d
Subroutine :
x(:) :real, intent(in)
: 漸増配列
point :real, intent(in)
: この点
i :integer, intent(inout)
: point の値を越えない最大の値をもつ要素番号
undeff :integer, intent(in), optional
: 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする. default では .false. (表示させる)

漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.

[Source]

subroutine interpo_search_1d( x, point, i, undeff, stdopt )
  ! 漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで,
  ! point の前に来る要素番号を出力する.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列
  real, intent(in) :: point  ! この点
  integer, intent(inout) :: i  ! point の値を越えない最大の値をもつ要素番号
  integer, intent(in), optional :: undeff  ! 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
                                           ! default では .false. (表示させる)
  integer :: nx, j
  integer :: just
  logical :: stderr

  nx=size(x)
  if(present(undeff))then
     just=undeff
  else
     just=-2147483648
  end if

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  do j=1,nx
     if(x(1)>point)then
        if(stderr.eqv..false.)then
           write(*,*) "****** WARNING ******"
           write(*,*) "searching point was not found :", x(1), point
           write(*,*) "Abort. Exit.!!!"
        end if
        i=just
        exit
     end if

     if(present(undeff))then
        if(x(j)/=real(undeff))then
           if(x(j)<=point)then
              i=j
           else
              exit
           end if
        end if
     else
        if(x(j)<=point)then
           i=j
        else
           exit
        end if
     end if
  end do

end subroutine interpo_search_1d
Subroutine :
x(:) :real, intent(in)
: 漸増配列 x
y(:) :real, intent(in)
: 漸増配列 y
pointx :real, intent(in)
: この点 x
pointy :real, intent(in)
: この点 y
i :integer, intent(inout)
: pointx の値を越えない最大の値をもつ要素番号
j :integer, intent(inout)
: pointy の値を越えない最大の値をもつ要素番号
undeff :integer, intent(in), optional
: 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする.

漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.

[Source]

subroutine interpo_search_2d( x, y, pointx, pointy, i, j, undeff, stdopt )
  ! 漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで,
  ! point の前に来る要素番号を出力する.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列 x
  real, intent(in) :: y(:)  ! 漸増配列 y
  real, intent(in) :: pointx  ! この点 x
  real, intent(in) :: pointy  ! この点 y
  integer, intent(inout) :: i  ! pointx の値を越えない最大の値をもつ要素番号
  integer, intent(inout) :: j  ! pointy の値を越えない最大の値をもつ要素番号
  integer, intent(in), optional :: undeff  ! 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
  integer :: just
  logical :: stderr

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  if(present(undeff))then
     just=undeff
     call interpo_search_1d( x, pointx, i, just, stdopt=stderr )
     call interpo_search_1d( y, pointy, j, just, stdopt=stderr )
  else
     call interpo_search_1d( x, pointx, i, stdopt=stderr )
     call interpo_search_1d( y, pointy, j, stdopt=stderr )
  end if

end subroutine interpo_search_2d
Subroutine :
x(:) :real, intent(in)
: 漸増配列 x
y(:) :real, intent(in)
: 漸増配列 y
z(:) :real, intent(in)
: 漸増配列 z
pointx :real, intent(in)
: この点 x
pointy :real, intent(in)
: この点 y
pointz :real, intent(in)
: この点 z
i :integer, intent(inout)
: pointx の値を越えない最大の値をもつ要素番号
j :integer, intent(inout)
: pointy の値を越えない最大の値をもつ要素番号
k :integer, intent(inout)
: pointz の値を越えない最大の値をもつ要素番号
undeff :integer, intent(in), optional
: 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
stdopt :logical, intent(in), optional
: 探索範囲が見つからない旨の標準出力を表示させないようにする.

漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.

[Source]

subroutine interpo_search_3d( x, y, z, pointx, pointy, pointz, i, j, k, undeff, stdopt )
  ! 漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで,
  ! point の前に来る要素番号を出力する.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列 x
  real, intent(in) :: y(:)  ! 漸増配列 y
  real, intent(in) :: z(:)  ! 漸増配列 z
  real, intent(in) :: pointx  ! この点 x
  real, intent(in) :: pointy  ! この点 y
  real, intent(in) :: pointz  ! この点 z
  integer, intent(inout) :: i  ! pointx の値を越えない最大の値をもつ要素番号
  integer, intent(inout) :: j  ! pointy の値を越えない最大の値をもつ要素番号
  integer, intent(inout) :: k  ! pointz の値を越えない最大の値をもつ要素番号
  integer, intent(in), optional :: undeff  ! 探索範囲の配列要素より小さい値を探索しようとした際, undef を返すが, その undef 値を設定する. default では 0.
  logical, intent(in), optional :: stdopt  ! 探索範囲が見つからない旨の標準出力を表示させないようにする.
  integer :: just
  logical :: stderr

  if(present(stdopt))then
     stderr=stdopt
  else
     stderr=.false.
  end if

  if(present(undeff))then
     just=int(undeff)
     call interpo_search_1d( x, pointx, i, just, stdopt=stderr )
     call interpo_search_1d( y, pointy, j, just, stdopt=stderr )
     call interpo_search_1d( z, pointz, k, just, stdopt=stderr )
  else
     call interpo_search_1d( x, pointx, i, stdopt=stderr )
     call interpo_search_1d( y, pointy, j, stdopt=stderr )
     call interpo_search_1d( z, pointz, k, stdopt=stderr )
  end if

end subroutine interpo_search_3d
Subroutine :
x(2) :real, intent(in)
: 内挿点の左右端
y(2) :real, intent(in)
: x の点で定義されている値
point :real, intent(in)
: 内挿点
val :real, intent(inout)
: 内挿点での値
h(2) :real, intent(in), optional
: 内挿点の左右でのスケール因子
hp :real, intent(in), optional
: 内挿点でのスケール因子

1 次の線形内挿ルーチン

[Source]

subroutine interpolation_1d( x, y, point, val, h, hp )
  ! 1 次の線形内挿ルーチン
  implicit none
  real, intent(in) :: x(2)  ! 内挿点の左右端
  real, intent(in) :: y(2)  ! x の点で定義されている値
  real, intent(in) :: point  ! 内挿点
  real, intent(inout) :: val  ! 内挿点での値
  real, intent(in), optional :: h(2)  ! 内挿点の左右でのスケール因子
  real, intent(in), optional :: hp  ! 内挿点でのスケール因子
  real :: fd, dt
  real :: tmin
  real :: tmax
  real :: xmin
  real :: xmax

  if(present(h))then
     tmin=x(1)*h(1)
     tmax=x(2)*h(2)
  else
     tmin=x(1)
     tmax=x(2)
  end if

  xmin=y(1)
  xmax=y(2)

  if(present(hp))then
     dt=hp*point-tmin
  else
     dt=point-tmin
  end if

  fd=(xmax-xmin)/(tmax-tmin)

  val=xmin+dt*fd
end subroutine interpolation_1d
Subroutine :
x(2) :real, intent(in)
: 内挿の空間点 x 方向の左右端
y(2) :real, intent(in)
: 内挿の空間点 y 方向の左右端
z(2,2) :real, intent(in)
: x, y での各点での値, (i,j) について, i<=x, j<=y
point(2) :real, intent(in)
: 内挿点 point(1)<=x 座標, point(2)<=y 座標
val :real, intent(inout)
: 内挿点での値
h(2,2) :real, intent(in), optional
: 内挿点の四隅でのスケール因子
hp(2) :real, intent(in), optional
: 内挿点でのスケール因子

2 次の重線形内挿ルーチン 本ルーチンは直線直交座標空間でのみ使用可能.

[Source]

subroutine interpolation_2d( x, y, z, point, val, h, hp )
  ! 2 次の重線形内挿ルーチン
  ! 本ルーチンは直線直交座標空間でのみ使用可能.
  implicit none
  real, intent(in) :: x(2)  ! 内挿の空間点 x 方向の左右端
  real, intent(in) :: y(2)  ! 内挿の空間点 y 方向の左右端
  real, intent(in) :: z(2,2)  ! x, y での各点での値, (i,j) について, i<=x, j<=y
  real, intent(in) :: point(2)  ! 内挿点 point(1)<=x 座標, point(2)<=y 座標
  real, intent(inout) :: val  ! 内挿点での値
  real, intent(in), optional :: h(2,2)  ! 内挿点の四隅でのスケール因子
  real, intent(in), optional :: hp(2)  ! 内挿点でのスケール因子
  real :: valx(2)

  if(present(h))then
     ! y(1) での x 方向の内挿点での値
     call interpolation_1d( x, (/z(1,1), z(2,1)/), point(1), valx(1), (/h(1,1), h(2,1)/), hp(1) )

     ! y(2) での x 方向の内挿点での値
     call interpolation_1d( x, (/z(1,2), z(2,2)/), point(1), valx(2), (/h(1,2), h(2,2)/), hp(1) )
   
     ! x の内挿点からの y 方向の内挿点での値(これが求める内挿点)
     call interpolation_1d( y, valx, point(2), val, (/h(1,1), h(1,2)/), hp(2) )
  else
     ! y(1) での x 方向の内挿点での値
     call interpolation_1d( x, (/z(1,1), z(2,1)/), point(1), valx(1) )

     ! y(2) での x 方向の内挿点での値
     call interpolation_1d( x, (/z(1,2), z(2,2)/), point(1), valx(2) )
   
     ! x の内挿点からの y 方向の内挿点での値(これが求める内挿点)
     call interpolation_1d( y, valx, point(2), val )
  end if

end subroutine interpolation_2d
Subroutine :
x(2) :real, intent(in)
: 内挿の空間点 x 方向の左右端
y(2) :real, intent(in)
: 内挿の空間点 y 方向の左右端
z(2) :real, intent(in)
: 内挿の空間点 z 方向の左右端
u(2,2,2) :real, intent(in)
: x, y, z での各点での値, (i,j,k) について, i<=x, j<=y, k<=z
point(3) :real, intent(in)
: 内挿点 point(1)<=x 座標, point(2)<=y 座標, point(3)<=z 座標
val :real, intent(inout)
: 内挿点での値
h(2,2,2) :real, intent(in), optional
: 内挿点の八隅でのスケール因子
hp(3) :real, intent(in), optional
: 内挿点でのスケール因子

3 次の重線形内挿ルーチン 本ルーチンは直線直交座標空間でのみ使用可能.

[Source]

subroutine interpolation_3d( x, y, z, u, point, val, h, hp )
  ! 3 次の重線形内挿ルーチン
  ! 本ルーチンは直線直交座標空間でのみ使用可能.
  implicit none
  real, intent(in) :: x(2)  ! 内挿の空間点 x 方向の左右端
  real, intent(in) :: y(2)  ! 内挿の空間点 y 方向の左右端
  real, intent(in) :: z(2)  ! 内挿の空間点 z 方向の左右端
  real, intent(in) :: u(2,2,2)  ! x, y, z での各点での値, (i,j,k) について, i<=x, j<=y, k<=z
  real, intent(in) :: point(3)  ! 内挿点 point(1)<=x 座標, point(2)<=y 座標, point(3)<=z 座標
  real, intent(inout) :: val  ! 内挿点での値
  real, intent(in), optional :: h(2,2,2)  ! 内挿点の八隅でのスケール因子
  real, intent(in), optional :: hp(3)  ! 内挿点でのスケール因子
  real :: valx(2)

  if(present(h))then
     ! z(1) での x-y 平面での重線形内挿の値
     call interpolation_2d( x, y, u(:,:,1), point(1:2), valx(1), h(:,:,1), hp(1:2) )
   
     ! z(2) での x 方向の内挿点での値
     call interpolation_2d( x, y, u(:,:,2), point(1:2), valx(2), h(:,:,2), hp(1:2) )
   
     ! z(1) の内挿点からの z 方向の内挿点での値(これが求める内挿点)
     call interpolation_1d( z, valx, point(3), val, h(1,1,:), hp(3) )
  else
     ! z(1) での x-y 平面での重線形内挿の値
     call interpolation_2d( x, y, u(:,:,1), point(1:2), valx(1) )
   
     ! z(2) での x 方向の内挿点での値
     call interpolation_2d( x, y, u(:,:,2), point(1:2), valx(2) )
   
     ! z(1) の内挿点からの z 方向の内挿点での値(これが求める内挿点)
     call interpolation_1d( (/z(1), z(2)/), (/valx(1), valx(2)/), point(3), val )
  end if

end subroutine interpolation_3d
Subroutine :
x(:) :real, intent(in)
: 漸増配列
point :real, intent(in)
: この点
i :integer, intent(inout)
: point の最近傍地点の要素番号
hx(size(x)) :real, intent(in), optional
: x 座標のスケール因子
hp :real, intent(in), optional
: point でのスケール因子 !! まだ用意しただけ

1 次元最近傍探索ルーチン interpo_search_1d から値を求め, その値と +1 した値の距離を比較して 距離の短い方を選択する.

[Source]

subroutine nearest_search_1d( x, point, i, hx, hp )
  ! 1 次元最近傍探索ルーチン
  ! interpo_search_1d から値を求め, その値と +1 した値の距離を比較して
  ! 距離の短い方を選択する.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列
  real, intent(in) :: point  ! この点
  integer, intent(inout) :: i  ! point の最近傍地点の要素番号
  real, intent(in), optional :: hx(size(x))  ! x 座標のスケール因子
  real, intent(in), optional :: hp  ! point でのスケール因子 !! まだ用意しただけ
  real :: tmp1, tmp2
  integer :: j, nx

  nx=size(x)

  call interpo_search_1d( x, point, j )

  if(j==0)then  ! i=1 にしたいので, tmp1 にx(1), tmp2 に x(2) を入れれば, 後の if 文
           ! でうまく処理される.
     tmp1=x(j+1)
     tmp2=x(j+2)
  else
     if(j==nx)then  ! i=nx にしたいので, tmp2 に x(nx), tmp1 に x(nx-1) を入れれば,
            ! 後の if 文でうまく処理される.
        tmp1=x(j)
        tmp2=x(j-1)
     else
        tmp1=x(j)
        tmp2=x(j+1)
     end if
  end if

  if(abs(point-tmp1)>abs(tmp2-point))then
     i=j+1
  else
     i=j
  end if

end subroutine nearest_search_1d
Subroutine :
x(:) :real, intent(in)
: 漸増配列 x
y(:) :real, intent(in)
: 漸増配列 y
pointx :real, intent(in)
: この点 x
pointy :real, intent(in)
: この点 y
i :integer, intent(inout)
: pointx の最近要素番号
j :integer, intent(inout)
: pointy の最近要素番号

2 次元最近傍探索ルーチン nearest_search_1d から値を求める. 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが, ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し, どちらも最近の点が求めたい 2 次元の最近点となる.

[Source]

subroutine nearest_search_2d( x, y, pointx, pointy, i, j )
  ! 2 次元最近傍探索ルーチン
  ! nearest_search_1d から値を求める.
  ! 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが,
  ! ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し,
  ! どちらも最近の点が求めたい 2 次元の最近点となる.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列 x
  real, intent(in) :: y(:)  ! 漸増配列 y
  real, intent(in) :: pointx  ! この点 x
  real, intent(in) :: pointy  ! この点 y
  integer, intent(inout) :: i  ! pointx の最近要素番号
  integer, intent(inout) :: j  ! pointy の最近要素番号

  call nearest_search_1d( x, pointx, i )
  call nearest_search_1d( y, pointy, j )

end subroutine nearest_search_2d
Subroutine :
x(:) :real, intent(in)
: 漸増配列 x
y(:) :real, intent(in)
: 漸増配列 y
z(:) :real, intent(in)
: 漸増配列 z
pointx :real, intent(in)
: この点 x
pointy :real, intent(in)
: この点 y
pointz :real, intent(in)
: この点 z
i :integer, intent(inout)
: pointx の最近要素番号
j :integer, intent(inout)
: pointy の最近要素番号
k :integer, intent(inout)
: pointz の最近要素番号

2 次元最近傍探索ルーチン nearest_search_1d から値を求める. 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが, ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し, どちらも最近の点が求めたい 2 次元の最近点となる.

[Source]

subroutine nearest_search_3d( x, y, z, pointx, pointy, pointz, i, j, k )
  ! 2 次元最近傍探索ルーチン
  ! nearest_search_1d から値を求める.
  ! 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが,
  ! ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し,
  ! どちらも最近の点が求めたい 2 次元の最近点となる.
  implicit none
  real, intent(in) :: x(:)  ! 漸増配列 x
  real, intent(in) :: y(:)  ! 漸増配列 y
  real, intent(in) :: z(:)  ! 漸増配列 z
  real, intent(in) :: pointx  ! この点 x
  real, intent(in) :: pointy  ! この点 y
  real, intent(in) :: pointz  ! この点 z
  integer, intent(inout) :: i  ! pointx の最近要素番号
  integer, intent(inout) :: j  ! pointy の最近要素番号
  integer, intent(inout) :: k  ! pointz の最近要素番号

  call nearest_search_1d( x, pointx, i )
  call nearest_search_1d( y, pointy, j )
  call nearest_search_1d( z, pointz, k )

end subroutine nearest_search_3d
Subroutine :
x(:) :real, intent(in)
: スムージングするデータ
n :integer, intent(in)
: スムーズの影響格子数(中心を含めた左右幅)
y(size(x)) :real, intent(inout)
: スムージングされたデータ
method :character(3), intent(in)
: スムージングの方法 "SMP" = 単純平均, "OPT" = オプション重み "MAX" = 最大値, "MIN" = 最小値
weight(n) :real, intent(in), optional
: method 引数が "OPT" の場合 weight(1) が左端, weight(n) が右端として重み
error :real, intent(in), optional
: 未定義値

1 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.

[Source]

subroutine smooth_1d( x, n, y, method, weight, error )
! 1 次元データについて, スムージングするルーチン
! 現在, error オプションは機能していない.
  implicit none
  real, intent(in) :: x(:)  ! スムージングするデータ
  integer, intent(in) :: n  ! スムーズの影響格子数(中心を含めた左右幅)
  real, intent(inout) :: y(size(x))  ! スムージングされたデータ
  character(3), intent(in) :: method  ! スムージングの方法
                            ! "SMP" = 単純平均, "OPT" = オプション重み
                            ! "MAX" = 最大値, "MIN" = 最小値
  real, intent(in), optional :: weight(n)  ! method 引数が "OPT" の場合
                            ! weight(1) が左端, weight(n) が右端として重み
  real, intent(in), optional :: error  ! 未定義値
  integer :: ix, j, mx, half, val
  real :: div_fact
  real :: wg(n)

  y=0.0
  mx=size(x)
  half=(n-1)/2

  select case (method(1:3))
  case ("SMP")
     do j=1,n
        wg(j)=1.0
     end do

  case ("OPT")
     if(present(weight))then
        do j=1,n
           wg(j)=weight(j)
        end do
     end if
  end select

  if(method(1:3)/="MIN".and.method(1:3)/="MAX")then
!-- determining dividing factor

     div_fact=0.0

     do j=1,n
        if(wg(j)<0.0)then
           div_fact=1.0
           exit
        else
           div_fact=div_fact+wg(j)
        end if
     end do

!-- avoiding zero dividing

     if(div_fact==0.0)then
        div_fact=1.0
     end if

     do ix=half+1,mx-half
        do j=1,n
           y(ix)=y(ix)+x(ix-half-1+j)*wg(j)
        end do
        y(ix)=y(ix)/div_fact
     end do

  else

     select case (method(1:3))
     case ("MAX")
        do ix=half+1,mx-half
           val=x(ix-half)
           do j=2,n
              if(val<x(ix-half-1+j))then
                 val=x(ix-half-1+j)
              end if
           end do
           y(ix-half)=val
        end do

     case ("MIN")
        do ix=half+1,mx-half
           val=x(ix-half)
           do j=2,n
              if(val>x(ix-half-1+j))then
                 val=x(ix-half-1+j)
              end if
           end do
           y(ix-half)=val
        end do

     end select

  end if

end subroutine smooth_1d
Subroutine :
x(:,:) :real, intent(in)
: スムージングするデータ
n :integer, intent(in)
: スムーズの影響格子数(中心を含めた左右幅)
y(size(x,1),size(x,2)) :real, intent(inout)
: スムージングされたデータ
method :character(3), intent(in)
: スムージングの方法 "SMP" = 単純平均, "OPT" = オプション重み "MAX" = 最大値, "MIN" = 最小値
weight(n,n) :real, intent(in), optional
: method 引数が "OPT" の場合 weight(1,1) が左下端, weight(n,n) が右上端として重み
error :real, intent(in), optional
: 未定義値

2 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.

[Source]

subroutine smooth_2d( x, n, y, method, weight, error )
! 2 次元データについて, スムージングするルーチン
! 現在, error オプションは機能していない.
  implicit none
  real, intent(in) :: x(:,:)  ! スムージングするデータ
  integer, intent(in) :: n  ! スムーズの影響格子数(中心を含めた左右幅)
  real, intent(inout) :: y(size(x,1),size(x,2))  ! スムージングされたデータ
  character(3), intent(in) :: method  ! スムージングの方法
                            ! "SMP" = 単純平均, "OPT" = オプション重み
                            ! "MAX" = 最大値, "MIN" = 最小値
  real, intent(in), optional :: weight(n,n)  ! method 引数が "OPT" の場合
                          ! weight(1,1) が左下端, weight(n,n) が右上端として重み
  real, intent(in), optional :: error  ! 未定義値
  integer :: ix, iy, j, k, mx, my, half, val
  real :: div_fact
  real :: wg(n,n)

  y=0.0
  mx=size(x,1)
  my=size(x,2)
  half=(n-1)/2

  select case (method(1:3))
  case ("SMP")
     do k=1,n
        do j=1,n
           wg(j,k)=1.0
        end do
     end do

  case ("OPT")
     if(present(weight))then
        do k=1,n
           do j=1,n
              wg(j,k)=weight(j,k)
           end do
        end do
     end if
  end select

  if(method(1:3)/="MIN".and.method(1:3)/="MAX")then
!-- determining dividing factor

     div_fact=0.0

     do k=1,n
        do j=1,n
           if(wg(j,k)<0.0)then
              div_fact=1.0
              exit
           else
              div_fact=div_fact+wg(j,k)
           end if
        end do
     end do

!-- avoiding zero dividing

     if(div_fact==0.0)then
        div_fact=1.0
     end if

     do iy=half+1,my-half
        do ix=half+1,mx-half
           do k=1,n
              do j=1,n
                 y(ix,iy)=y(ix,iy)+x(ix-half-1+j,iy-half-1+k)*wg(j,k)
              end do
           end do

           y(ix,iy)=y(ix,iy)/div_fact
        end do
     end do

  else

     select case (method(1:3))
     case ("MAX")
        do iy=half+1,my-half
           do ix=half+1,mx-half
              val=x(ix-half,iy-half)
              do k=2,n
                 do j=2,n
                    if(val<x(ix-half-1+j,iy-half-1+k))then
                       val=x(ix-half-1+j,iy-half-1+k)
                    end if
                 end do
              end do
              y(ix-half,iy-half)=val
           end do
        end do

     case ("MIN")
        do iy=half+1,my-half
           do ix=half+1,mx-half
              val=x(ix-half,iy-half)
              do k=2,n
                 do j=2,n
                    if(val>x(ix-half-1+j,iy-half-1+k))then
                       val=x(ix-half-1+j,iy-half-1+k)
                    end if
                 end do
              end do
              y(ix-half,iy-half)=val
           end do
        end do

     end select

  end if

end subroutine smooth_2d
Subroutine :
x(:,:,:) :real, intent(in)
: スムージングするデータ
n :integer, intent(in)
: スムーズの影響格子数(中心を含めた左右幅)
y(size(x,1),size(x,2),size(x,3)) :real, intent(inout)
: スムージングされたデータ
method :character(3), intent(in)
: スムージングの方法 "SMP" = 単純平均, "OPT" = オプション重み "MAX" = 最大値, "MIN" = 最小値
weight(n,n,n) :real, intent(in), optional
: method 引数が "OPT" の場合
error :real, intent(in), optional
: 未定義値

3 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.

[Source]

subroutine smooth_3d( x, n, y, method, weight, error )
! 3 次元データについて, スムージングするルーチン
! 現在, error オプションは機能していない.
  implicit none
  real, intent(in) :: x(:,:,:)  ! スムージングするデータ
  integer, intent(in) :: n  ! スムーズの影響格子数(中心を含めた左右幅)
  real, intent(inout) :: y(size(x,1),size(x,2),size(x,3))
                            ! スムージングされたデータ
  character(3), intent(in) :: method  ! スムージングの方法
                            ! "SMP" = 単純平均, "OPT" = オプション重み
                            ! "MAX" = 最大値, "MIN" = 最小値
  real, intent(in), optional :: weight(n,n,n)  ! method 引数が "OPT" の場合
  real, intent(in), optional :: error  ! 未定義値
  integer :: ix, iy, iz, j, k, l, mx, my, mz, half, val
  real :: div_fact
  real :: wg(n,n,n)

  y=0.0
  mx=size(x,1)
  my=size(x,2)
  mz=size(x,3)
  half=(n-1)/2

  select case (method(1:3))
  case ("SMP")
     do l=1,n
        do k=1,n
           do j=1,n
              wg(j,k,l)=1.0
           end do
        end do
     end do

  case ("OPT")
     if(present(weight))then
        do l=1,n
           do k=1,n
              do j=1,n
                 wg(j,k,l)=weight(j,k,l)
              end do
           end do
        end do
     end if
  end select

  if(method(1:3)/="MIN".and.method(1:3)/="MAX")then
!-- determining dividing factor

     div_fact=0.0

     do l=1,n
        do k=1,n
           do j=1,n
              if(wg(j,k,l)<0.0)then
                 div_fact=1.0
                 exit
              else
                 div_fact=div_fact+wg(j,k,l)
              end if
           end do
        end do
     end do

!-- avoiding zero dividing

     if(div_fact==0.0)then
        div_fact=1.0
     end if

     do iz=half+1,mz-half
        do iy=half+1,my-half
           do ix=half+1,mx-half
              do l=1,n
                 do k=1,n
                    do j=1,n
                       y(ix,iy,iz)=y(ix,iy,iz) +x(ix-half-1+j,iy-half-1+k,iz-half-1+l) *wg(j,k,l)
                    end do
                 end do
              end do

              y(ix,iy,iz)=y(ix,iy,iz)/div_fact
           end do
        end do
     end do

  else

     select case (method(1:3))
     case ("MAX")
        do iz=half+1,mz-half
           do iy=half+1,my-half
              do ix=half+1,mx-half
                 val=x(ix-half,iy-half,iz-half)
                 do l=2,n
                    do k=2,n
                       do j=2,n
                          if(val<x(ix-half-1+j,iy-half-1+k,iz-half-1+l))then
                             val=x(ix-half-1+j,iy-half-1+k,iz-half-1+l)
                          end if
                       end do
                    end do
                 end do
                 y(ix-half,iy-half,iz-half)=val
              end do
           end do
        end do

     case ("MIN")
        do iz=half+1,mz-half
           do iy=half+1,my-half
              do ix=half+1,mx-half
                 val=x(ix-half,iy-half,iz-half)
                 do l=2,n
                    do k=2,n
                       do j=2,n
                          if(val>x(ix-half-1+j,iy-half-1+k,iz-half-1+l))then
                             val=x(ix-half-1+j,iy-half-1+k,iz-half-1+l)
                          end if
                       end do
                    end do
                 end do
                 y(ix-half,iy-half,iz-half)=val
              end do
           end do
        end do

     end select

  end if

end subroutine smooth_3d
stand_vari( x, anor, [error] )
Subroutine :
x(:) :real, intent(in)
: データ
anor :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

1 次元データの標準偏差を計算 標準偏差$sigma $の定義は, $$sigma =sum^{nx}_{i=1}{epsilon ^2} $$ ただし, $epsilon $は平均値からのずれ$x-\bar{x}$である.

Alias for stand_vari_1d

Subroutine :
x(:) :real, intent(in)
: データ
anor :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

1 次元データの標準偏差を計算 標準偏差$sigma $の定義は, $$sigma =sum^{nx}_{i=1}{epsilon ^2} $$ ただし, $epsilon $は平均値からのずれ$x-\bar{x}$である.

[Source]

subroutine stand_vari_1d( x, anor, error )  ! 1 次元データの標準偏差を計算
  ! 標準偏差$\sigma $の定義は,
  ! $$\sigma =\sum^{nx}_{i=1}{epsilon ^2} $$
  ! ただし, $\epsilon $は平均値からのずれ$x-\bar{x}$である.
  implicit none
  real, intent(in) :: x(:)  ! データ
  real, intent(inout) :: anor  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i
  integer :: nx  ! データ数
  real :: an(size(x))

  nx=size(x)
  anor=0.0

  if(present(error))then
     call Anomaly_1d( x, an, error )
     do i=1,nx
        if(x(i)/=error)then
           anor=anor+an(i)**2
        end if
     end do
  else
     call Anomaly_1d( x, an )
     do i=1,nx
        anor=anor+an(i)**2
     end do
  end if

end subroutine stand_vari_1d
Subroutine :
x(:,:) :real, intent(in)
: データ
anor :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

2 次元データの標準偏差を計算

[Source]

subroutine stand_vari_2d( x, anor, error )  ! 2 次元データの標準偏差を計算
  implicit none
  real, intent(in) :: x(:,:)  ! データ
  real, intent(inout) :: anor  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  real :: val(size(x,1)*size(x,2))

  nx=size(x,1)
  ny=size(x,2)

  counter=0
  do j=1,ny
     do i=1,nx
        counter=counter+1
        val(counter)=x(i,j)
     end do
  end do

  anor=0.0

  if(present(error))then
     call stand_vari_1d( val, anor, error )
  else
     call stand_vari_1d( val, anor )
  end if

end subroutine stand_vari_2d
Subroutine :
x(:,:,:) :real, intent(in)
: データ
anor :real, intent(inout)
: 標準偏差
error :real, intent(in), optional
: 欠損値

3 次元データの標準偏差を計算

[Source]

subroutine stand_vari_3d( x, anor, error )  ! 3 次元データの標準偏差を計算
  implicit none
  real, intent(in) :: x(:,:,:)  ! データ
  real, intent(inout) :: anor  ! 標準偏差
  real, intent(in), optional :: error  ! 欠損値
  integer :: i, j, k, counter
  integer :: nx  ! データ数 1
  integer :: ny  ! データ数 2
  integer :: nz  ! データ数 3
  real :: val(size(x,1)*size(x,2)*size(x,3))

  nx=size(x,1)
  ny=size(x,2)
  nz=size(x,3)

  counter=0
  do k=1,nz
     do j=1,ny
        do i=1,nx
           counter=counter+1
           val(counter)=x(i,j,k)
        end do
     end do
  end do

  anor=0.0

  if(present(error))then
     call stand_vari_1d( val, anor, error )
  else
     call stand_vari_1d( val, anor )
  end if

end subroutine stand_vari_3d