Class | Statistics |
In: |
statistics.f90
|
統計解析関係のルーチン集
Subroutine : | |||
x(:) : | real, intent(in)
| ||
anor(size(x)) : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
1 次元データ配列の偏差を返す
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)
| ||
error : | real, intent(in), optional
|
2 次元データ配列の偏差を返す
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)
| ||
error : | real, intent(in), optional
|
3 次元データ配列の偏差を返す
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
Subroutine : | |||
a(:) : | integer, intent(in)
| ||
b(size(a)) : | integer, intent(inout)
| ||
sig : | character(1), intent(in)
|
バブルソートを用いて数値データを sig の方向にソートする.
Alias for Bubble_Sort_i
Subroutine : | |||
a(:) : | real, intent(in)
| ||
b(size(a)) : | real, intent(inout)
| ||
sig : | character(1), intent(in)
|
バブルソートを用いて数値データを sig の方向にソートする.
Alias for Bubble_Sort_f
Subroutine : | |||
a(:) : | real, intent(in)
| ||
b(size(a)) : | real, intent(inout)
| ||
sig : | character(1), intent(in)
|
バブルソートを用いて数値データを sig の方向にソートする.
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)
|
バブルソートを用いて数値データを sig の方向にソートする.
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
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
cc : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 データの相関係数を計算するルーチン
Alias for Cor_Coe_1d
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
cc : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 データの相関係数を計算するルーチン
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)
| ||
y(size(x,1),size(x,2)) : | real, intent(in)
| ||
cc : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 データの相関係数を計算するルーチン (2 次元版)
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)
| ||
y(size(x,1),size(x,2),size(x,3)) : | real, intent(in)
| ||
cc : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 データの相関係数を計算するルーチン (3 次元版)
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
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
最小二乗法による傾きと切片計算 (1 次元データ版)
Alias for LSM_1d
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
最小二乗法による傾きと切片計算 (1 次元データ版)
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)
| ||
y(size(x,1),size(x,2)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
最小二乗法による傾きと切片計算 (2 次元データ版)
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)
| ||
y(size(x,1),size(x,2),size(x,3)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
最小二乗法による傾きと切片計算 (3 次元データ版)
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
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
a(:) : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
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)
| ||
y(size(x)) : | real, intent(in)
| ||
a(:) : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
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 ルーチンを使用.
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)
| ||
y(size(x,1),size(x,2)) : | real, intent(in)
| ||
a(:) : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
LSM の多項式近似バージョン. (2 次元データ版)
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)
| ||
y(size(x,1),size(x,2),size(x,3)) : | real, intent(in)
| ||
a(:) : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
LSM の多項式近似バージョン. (3 次元データ版)
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 次元配列平均値計算ルーチン
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 次元配列平均値計算ルーチン
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 次元配列平均値計算ルーチン
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)
| ||
error : | real, intent(in), optional
| ||
offset : | integer, intent(in), optional
|
移動平均からのアノマリを計算するルーチン
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)
| ||
error : | real, intent(in), optional
| ||
offset : | integer, intent(in), optional
|
移動平均を計算するルーチン
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
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
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)
| ||
y(size(x)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
undef : | real, intent(in), optional
|
LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン
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)
| ||
y(size(x,1),size(x,2)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
error : | real, intent(in), optional |
LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (2 次元版)
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)
| ||
y(size(x,1),size(x,2),size(x,3)) : | real, intent(in)
| ||
slope : | real, intent(inout)
| ||
intercept : | real, intent(inout)
| ||
error : | real, intent(in), optional |
LSM を用いて回帰直線の傾き slope と切片 intercept を計算するルーチン (3 次元版)
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
| ||
stdopt : | logical, intent(in), optional
|
座標 x で定義されているデータ u を 座標 r で定義されるデータ v に自動で内挿する.
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).and.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 v(i)=real(defun) end if end do end subroutine auto_interpolation_1d
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(:) : | real, intent(in)
| ||
r(:) : | real, intent(in)
| ||
q(:) : | real, intent(in)
| ||
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
| ||
stdopt : | logical, intent(in), optional
|
座標 x, y で定義されているデータ u を 座標 r, q で定義されるデータ v に自動で内挿する.
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).and.ir<nx.and.iq<ny)then if(u(ir,iq)/=rdefun.and.u(ir+1,iq)/=rdefun.and. u(ir,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 v(i,j)=real(defun) end if end do end do end subroutine auto_interpolation_2d
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(:) : | real, intent(in)
| ||
z(:) : | real, intent(in)
| ||
r(:) : | real, intent(in)
| ||
q(:) : | real, intent(in)
| ||
p(:) : | real, intent(in)
| ||
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
| ||
stdopt : | logical, intent(in), optional
|
座標 x, y, z で定義されているデータ u を 座標 r, q, p で定義されるデータ v に自動で内挿する.
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).and. ir<nx.and.iq<ny.and.ip<nz)then if(u(ir,iq,ip)/=rdefun.and.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 v(i,j,k)=real(defun) end if end do end do end do end subroutine auto_interpolation_3d
Subroutine : | |||
x(:) : | real, intent(in)
| ||
y(size(x)) : | real, intent(in)
| ||
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)
| ||
y(size(x)) : | real, intent(in)
| ||
cov : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 つの 1 次元データの共分散を計算 共分散$sigma $の定義は, $$sigma =sum^{nx}_{i=1}{(x-\bar{x})(y-\bar{y})} $$
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)
| ||
y(size(x,1),size(x,2)) : | real, intent(in)
| ||
cov : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 つの 2 次元データの共分散を計算
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)
| ||
y(size(x,1),size(x,2),size(x,3)) : | real, intent(in)
| ||
cov : | real, intent(inout)
| ||
error : | real, intent(in), optional
|
2 つの 3 次元データの共分散を計算
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)
| ||
undeff : | integer, intent(in), optional
| ||
stdopt : | logical, intent(in), optional
|
漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.
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)
| ||
y(:) : | real, intent(in)
| ||
pointx : | real, intent(in)
| ||
pointy : | real, intent(in)
| ||
i : | integer, intent(inout)
| ||
j : | integer, intent(inout)
| ||
undeff : | integer, intent(in), optional
| ||
stdopt : | logical, intent(in), optional
|
漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.
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)
| ||
y(:) : | real, intent(in)
| ||
z(:) : | real, intent(in)
| ||
pointx : | real, intent(in)
| ||
pointy : | real, intent(in)
| ||
pointz : | real, intent(in)
| ||
i : | integer, intent(inout)
| ||
j : | integer, intent(inout)
| ||
k : | integer, intent(inout)
| ||
undeff : | integer, intent(in), optional
| ||
stdopt : | logical, intent(in), optional
|
漸増配列(要素数が増えるごとに値が大きくなる配列)のなかで, point の前に来る要素番号を出力する.
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)
| ||
point : | real, intent(in)
| ||
val : | real, intent(inout)
| ||
h(2) : | real, intent(in), optional
| ||
hp : | real, intent(in), optional
|
1 次の線形内挿ルーチン
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)
| ||
y(2) : | real, intent(in)
| ||
z(2,2) : | real, intent(in)
| ||
point(2) : | real, intent(in)
| ||
val : | real, intent(inout)
| ||
h(2,2) : | real, intent(in), optional
| ||
hp(2) : | real, intent(in), optional
|
2 次の重線形内挿ルーチン 本ルーチンは直線直交座標空間でのみ使用可能.
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)
| ||
y(2) : | real, intent(in)
| ||
z(2) : | real, intent(in)
| ||
u(2,2,2) : | real, intent(in)
| ||
point(3) : | real, intent(in)
| ||
val : | real, intent(inout)
| ||
h(2,2,2) : | real, intent(in), optional
| ||
hp(3) : | real, intent(in), optional
|
3 次の重線形内挿ルーチン 本ルーチンは直線直交座標空間でのみ使用可能.
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)
| ||
hx(size(x)) : | real, intent(in), optional
| ||
hp : | real, intent(in), optional
|
1 次元最近傍探索ルーチン interpo_search_1d から値を求め, その値と +1 した値の距離を比較して 距離の短い方を選択する.
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)
| ||
y(:) : | real, intent(in)
| ||
pointx : | real, intent(in)
| ||
pointy : | real, intent(in)
| ||
i : | integer, intent(inout)
| ||
j : | integer, intent(inout)
|
2 次元最近傍探索ルーチン nearest_search_1d から値を求める. 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが, ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し, どちらも最近の点が求めたい 2 次元の最近点となる.
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)
| ||
y(:) : | real, intent(in)
| ||
z(:) : | real, intent(in)
| ||
pointx : | real, intent(in)
| ||
pointy : | real, intent(in)
| ||
pointz : | real, intent(in)
| ||
i : | integer, intent(inout)
| ||
j : | integer, intent(inout)
| ||
k : | integer, intent(inout)
|
2 次元最近傍探索ルーチン nearest_search_1d から値を求める. 本来, 2 次元であるため, 周囲 4 点の最近を計算する必要があるが, ここでは直交直線座標を考えているので, 各軸方向独立で最近点を計算し, どちらも最近の点が求めたい 2 次元の最近点となる.
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)
| ||
weight(n) : | real, intent(in), optional
| ||
error : | real, intent(in), optional
|
1 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.
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)
| ||
weight(n,n) : | real, intent(in), optional
| ||
error : | real, intent(in), optional
|
2 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.
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)
| ||
weight(n,n,n) : | real, intent(in), optional
| ||
error : | real, intent(in), optional
|
3 次元データについて, スムージングするルーチン 現在, error オプションは機能していない.
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
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}$である.
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 次元データの標準偏差を計算
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 次元データの標準偏差を計算
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