| Class | sltt_lagint |
| In: |
sltt/sltt_lagint.F90
|
Note that Japanese and English are described in parallel.
セミラグランジュ法で用いる補間を演算するモジュールです. スペクトル変換・高精度補間に由来する人工的な短波を除去するために Sun et al. (1996) の 単調フィルタを応用したものを部分的に用いている。
This is a Interpolation module. Semi-Lagrangian method (Enomoto 2008 modified) Monotonicity filter (Sun et al 1996) is partly used.
| SLTTLagIntCubCalcFactHor : | 水平2次元ラグランジュ3次補間用の係数計算 |
| SLTTLagIntCubIntHor : | 水平2次元ラグランジュ3次補間(上流点探索で用いる) |
| SLTTLagIntCubCalcFactVer : | 鉛直1次元ラグランジュ3次補間用の係数計算 |
| SLTTLagIntCubIntVer : | 鉛直1次元ラグランジュ3次補間(上流点探索で用いる) |
| SLTTIrrHerIntK13 : | 水平2次元変則エルミート5次補間 |
| SLTTIrrHerIntQui2DHor : | 水平2次元変則エルミート5次補間(コア部分) |
| SLTTIrrHerIntQui1DUni : | 1次元変則エルミート5次補間(等間隔格子) |
| SLTTIrrHerIntQui1DNonUni : | 1次元変則エルミート5次補間(不等間隔格子) |
| SLTTIrrHerIntQui1DUniLon : | 1次元変則エルミート5次補間(等間隔:経度方向専用) |
| SLTTHerIntCub1D : | 1次元エルミート3次補間 |
| SLTTHerIntCub2D : | 2次元エルミート3次補間 |
| ——————— : | ———— |
| SLTTLagIntCubCalcFactHor : | Calculation of factors for 2D Lagrangian Cubic Interpolation |
| SLTTLagIntCubIntHor : | 2D Lagrangian Cubic Interpolation used in finding DP in horizontal |
| SLTTLagIntCubCalcFactVer : | Calculation of factors for 1D Lagrangian Cubic Interpolation |
| SLTTLagIntCubIntVer : | 1D Lagrangian Cubic Interpolation used in finding DP in vertical |
| SLTTHerIntK13 : | Horizontal 2D Irregular Hermite Quintic Interpolation |
| SLTTIrrHerIntQui2DHor : | Horizontal 2D Irregular Hermite Quintic Interpolation (Core) |
| SLTTIrrHerIntQui1DUni : | 1D Irregular Hermite Quintic Interpolation for uniform grids |
| SLTTIrrHerIntQui1DNonUni : | 1D Irregular Hermite Quintic Interpolation for non-uniform grids |
| SLTTIrrHerIntQui1DUniLon : | 1D Irregular Hermite Quintic Interpolation for uniform longitude grids |
| SLTTHerIntCub1D : | 1D Hermite Cubic Interpolation |
| SLTTHerIntCub2D : | 2D Hermite Cubic Interpolation |
NAMELIST#
種別型パラメタ Kind type parameter
| Function : | |
| f1 : | real(DP), intent(in) |
| f2 : | real(DP), intent(in) |
| g1 : | real(DP), intent(in) |
| g2 : | real(DP), intent(in) |
| dx : | real(DP), intent(in) |
エルミート3次補間 1D Hermite Cubic Interpolation
1-----x------2
f:関数値、g:微分値、dx:点1と点2の間隔、Xi:点1と補間する点xとの間隔 f:function value, g:derivative, dx:distance between 1 and 2, Xi:distance between 1 and x
function SLTTHerIntCub1D(f1, f2, g1, g2, dx, Xi) result (fout)
!エルミート3次補間
! 1D Hermite Cubic Interpolation
! 1-----x------2
! f:関数値、g:微分値、dx:点1と点2の間隔、Xi:点1と補間する点xとの間隔
! f:function value, g:derivative, dx:distance between 1 and 2, Xi:distance between 1 and x
implicit none
real(DP), intent(in) :: f1, f2, g1, g2
real(DP), intent(in) :: dx, Xi
real(DP) :: fout
!------Internal variables-------
real(DP):: a, b
real(DP):: indx
indx = 1.0_DP/dx
a = (g1 + g2)*indx*indx + 2.0_DP*(f1 - f2)*indx*indx*indx
b = 3.0_DP*(f2 - f1)*indx*indx - (2.0_DP*g1 + g2)*indx
fout = a*Xi*Xi*Xi + b*Xi*Xi + g1*Xi + f1
end function SLTTHerIntCub1D
| Function : | |
| f : | real(DP), dimension(4), intent(in) |
| fx : | real(DP), dimension(4), intent(in) |
| fy : | real(DP), dimension(4), intent(in) |
| fxy : | real(DP), dimension(4), intent(in) |
| dx : | real(DP), intent(in) |
| dy : | real(DP), intent(in) |
| Xix : | real(DP), intent(in) |
2次元エルミート3次補間 2D Hermite Cubic Interpolation
4----b------3
|
X
|
1----a------2
Xix:点1と点aとの間隔、Xiy:点aと点Xとの間隔 Xix:distance between 1 and a, Xiy:distance between a and X
function SLTTHerIntCub2D(f, fx, fy, fxy, dx, dy, Xix, Xiy) result (fout)
!2次元エルミート3次補間
! 2D Hermite Cubic Interpolation
! 4----b------3
! |
! X
! |
! 1----a------2
! Xix:点1と点aとの間隔、Xiy:点aと点Xとの間隔
! Xix:distance between 1 and a, Xiy:distance between a and X
implicit none
real(DP), dimension(4), intent(in) :: f, fx, fy, fxy
real(DP), intent(in) :: dx, dy, Xix, Xiy
real(DP) :: fout
!------Internal variables-------
real(DP) :: fa, fb, fya, fyb
! 点1と点2から点aでの値を求める
! interpolate a from 1 and 2
fa = SLTTHerIntCub1D(f(1), f(2), fx(1), fx(2), dx, Xix)
fya = SLTTHerIntCub1D(fy(1), fy(2), fxy(1), fxy(2), dx, Xix)
! 点4と点3から点bでの値を求める
! interpolate b from 4 and 3
fb = SLTTHerIntCub1D(f(4), f(3), fx(4), fx(3), dx, Xix)
fyb = SLTTHerIntCub1D(fy(4), fy(3), fxy(4), fxy(3), dx, Xix)
! 点aと点bから点Xをでの値を求める
! interpolate X from a and b
fout = SLTTHerIntCub1D(fa, fb, fya, fyb, dy, Xiy)
end function SLTTHerIntCub2D
| Subroutine : | |||
| iexmin : | integer , intent(in ) | ||
| iexmax : | integer , intent(in ) | ||
| jexmin : | integer , intent(in ) | ||
| jexmax : | integer , intent(in ) | ||
| x_ExtLon(iexmin:iexmax) : | real(DP), intent(in )
| ||
| y_ExtLat(jexmin:jexmax) : | real(DP), intent(in )
| ||
| xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
| xyz_ExtQMixB_dlon(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in)
| ||
| xyz_ExtQMixB_dlat(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in)
| ||
| xyz_ExtQMixB_dlonlat(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in)
| ||
| SLTTIntHor : | character(TOKEN), intent(in)
| ||
| xyz_QMixA( 0:imax-1 , 1:jmax/2 , 1:kmax, 1:ncmax) : | real(DP), intent(out)
|
水平方向の2次元補間。Enomoto (2008, SOLA)で提案された「スペクトルで計算した微分値を用いた双3次補間」を 発展させた方法、スペクトル微分を用いた変則エルミート5次補間を方向分離して行う。5次補間のたびに Sun et al. (1996, MWR) の単調フィルタを修正したものを適用する。 2D Interpolation. Spectral transformation is used for calculation of derivatives, which are used for Irregular Hermite quintic interpolation. The original idea of using Spectral transformation for derivatives is presented by Enomoto (2008, SOLA). Monotonicity filter presented by Sun et al. (1996, MWR) is partly modified and used after each interpolation.
subroutine SLTTIrrHerIntK13( iexmin, iexmax, jexmin, jexmax, x_ExtLon, y_ExtLat, xyz_DPLon, xyz_DPLat, xyz_ExtQMixB, xyz_ExtQMixB_dlon, xyz_ExtQMixB_dlat, xyz_ExtQMixB_dlonlat, SLTTIntHor, xyz_QMixA )
! 水平方向の2次元補間。Enomoto (2008, SOLA)で提案された「スペクトルで計算した微分値を用いた双3次補間」を
! 発展させた方法、スペクトル微分を用いた変則エルミート5次補間を方向分離して行う。5次補間のたびに Sun et al. (1996, MWR)
! の単調フィルタを修正したものを適用する。
! 2D Interpolation. Spectral transformation is used for calculation of derivatives, which are used
! for Irregular Hermite quintic interpolation. The original idea of using Spectral transformation for derivatives
! is presented by Enomoto (2008, SOLA).
! Monotonicity filter presented by Sun et al. (1996, MWR) is partly modified and used after each interpolation.
use sltt_const , only : PIx2
use mpi_wrapper, only : myrank
use gridset, only: lmax ! スペクトルデータの配列サイズ
! Size of array for spectral data
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP), intent(in ) :: x_ExtLon(iexmin:iexmax)
! 経度の拡張配列
! Extended array of Lon
real(DP), intent(in ) :: y_ExtLat(jexmin:jexmax)
! 緯度の拡張配列
! Extended array of Lat
real(DP), intent(in ) :: xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の経度
! Lon at departure point
real(DP), intent(in ) :: xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の緯度
! Lat at departure point
real(DP), intent(in ) :: xyz_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の拡張配列
! Extended array of mix ration of tracers
real(DP), intent(in) :: xyz_ExtQMixB_dlon(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の経度微分の拡張配列
! Extended array of zonal derivative of the mix ration
real(DP), intent(in) :: xyz_ExtQMixB_dlat(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の緯度微分の拡張配列
! Extended array of meridional derivative of the mix ration
real(DP), intent(in) :: xyz_ExtQMixB_dlonlat(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の緯度経度微分の拡張配列
! Extended array of zonal and meridional derivative of the mix ration
character(TOKEN), intent(in):: SLTTIntHor
! 水平方向の補間方法を指定するキーワード
! Keyword for Interpolation Method for Horizontal direction
real(DP), intent(out) :: xyz_QMixA ( 0:imax-1 , 1:jmax/2 , 1:kmax, 1:ncmax)
! 次ステップの物質混合比
! Mix ration of tracers at next time-step
!---fxx, fyy, fxxy, fxyy, fxxyy
! real(DP), intent(inout) :: xyz_ExtQMixB_dlon2(-2+0:imax-1+3, -jew+1:jmax/2+jew, 1:kmax)
! real(DP), intent(inout) :: xyz_ExtQMixB_dlat2(-2+0:imax-1+3, -jew+1:jmax/2+jew, 1:kmax)
! real(DP), intent(inout) :: xyz_ExtQMixB_dlon2lat(-2+0:imax-1+3, -jew+1:jmax/2+jew, 1:kmax)
! real(DP), intent(inout) :: xyz_ExtQMixB_dlonlat2(-2+0:imax-1+3, -jew+1:jmax/2+jew, 1:kmax)
! real(DP), intent(inout) :: xyz_ExtQMixB_dlon2lat2(-2+0:imax-1+3, -jew+1:jmax/2+jew, 1:kmax)
real(DP) :: DeltaLat ! 緯度グリッド幅; grid width in meridional direction
integer:: i, ii ! 東西方向に回る DO ループ用作業変数
! Work variables for DO loop in zonal direction
integer:: j, jj ! 南北方向に回る DO ループ用作業変数
! Work variables for DO loop in meridional direction
integer:: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer:: n ! 組成方向に回る DO ループ用作業変数
! Work variables for DO loop in number of composition
integer :: isten ! 上流点を囲む4格子点の南西の点の座標番号(東西方向)
! Youngest index of grid points around the departure point (i-direction)
integer :: jsten ! 上流点を囲む4格子点の南西の点の座標番号(南北方向)
! Youngest index of grid points around the departure point (j-direction)
integer :: num ! 配列配置のための作業変数
! Work variable for array packing
real(DP) :: a_z(16) ! 上流点を囲む16格子点上の混合比を格納する作業変数
! Work variable containing mixing ratio at 16 grid points around DP
real(DP) :: a_zx(16) ! 上流点を囲む16格子点上の混合比の経度微分を格納する作業変数
! Work variable containing zonal derivative of mixing ratio at 16 grid points around DP
real(DP) :: a_zy(16) ! 上流点を囲む16格子点上の混合比の緯度微分を格納する作業変数
! Work variable containing meridional derivative of mixing ratio at 16 grid points around DP
real(DP) :: a_zxy(16) ! 上流点を囲む16格子点上の混合比の緯度経度微分を格納する作業変数
! Work variable containing zonal and meridional derivative of mixing ratio at 16 grid points around DP
! real(DP):: a_zxx(16), a_zyy(16), a_zxxy(16), a_zxyy(16), a_zxxyy(16)
! Check whether a longitude of departure point is within an extended array
call SLTTLagIntChkDPLon( SLTTIntHor, iexmin, iexmax, jexmin, jexmax, x_ExtLon, xyz_DPLon )
! Check whether a latitude of departure point is within an extended array
call SLTTLagIntChkDPLat( SLTTIntHor, iexmin, iexmax, jexmin, jexmax, y_ExtLat, xyz_DPLat )
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
! 上流点を囲む4点を探す
! Determine four grid points around the departure point
isten = int(xyz_DPLon(i,j,k)*InvDeltaLon)
do jj = jexmin, jexmax
if (y_ExtLat(jj) > xyz_DPLat(i, j, k)) then
jsten = jj-1
exit
endif
enddo
!MPIに対応できない↓
! jsten = int(xyz_DPLat(i,j,k)*in_deltalat) + ns + 1
! if (y_ExtLat(jsten) > xyz_DPLat(i, j, k)) then
! jsten = jsten - 1
! endif
! 水平方向の補間方法の選択
select case (SLTTIntHor)
case ("HQ") ! 方向分離型2次元変則エルミート5次補間; 2D Hermite quintic interpolation
do n = 1, ncmax
! 2次元補間のための配列配置(ワイド)
! Array packing for 2D interpolation
do jj = -1, 2
num = (jj+1)*4 + 2
do ii = -1, 2
a_z(ii+num) = xyz_ExtQMixB(isten+ii, jsten+jj, k, n)
a_zx(ii+num) = xyz_ExtQMixB_dlon(isten+ii, jsten+jj, k, n)
a_zy(ii+num) = xyz_ExtQMixB_dlat(isten+ii, jsten+jj, k, n)
a_zxy(ii+num) = xyz_ExtQMixB_dlonlat(isten+ii, jsten+jj, k, n)
enddo
enddo
! 方向分離型2次元変則エルミート5次補間
! 2D Hermite quintic interpolation
xyz_QMixA(i,j,k,n) = SLTTIrrHerIntQui2DHor(a_z, a_zx, a_zy, a_zxy, y_ExtLat(jsten-1)-y_ExtLat(jsten), y_ExtLat(jsten+1)-y_ExtLat(jsten), y_ExtLat(jsten+2)-y_ExtLat(jsten), xyz_DPLon(i, j, k)-x_ExtLon(isten), xyz_DPLat(i, j, k)-y_ExtLat(jsten) )
enddo
case("HC") !方向分離型2次元エルミート3次補間; 2D Hermite Cubic Interpolation
do n = 1, ncmax
! 2次元補間のための配列配置
! 4 3
! x
! 1 2
a_z(1) = xyz_ExtQMixB(isten, jsten, k, n)
a_zx(1) = xyz_ExtQMixB_dlon(isten, jsten, k, n)
a_zy(1) = xyz_ExtQMixB_dlat(isten, jsten, k, n)
a_zxy(1) = xyz_ExtQMixB_dlonlat(isten, jsten, k, n)
! a_zxx(1) = xyz_ExtQMixB_dlon2(isten, jsten, k, n)
! a_zyy(1) = xyz_ExtQMixB_dlat2(isten, jsten, k, n)
! a_zxxy(1) = xyz_ExtQMixB_dlon2lat(isten, jsten, k, n)
! a_zxyy(1) = xyz_ExtQMixB_dlonlat2(isten, jsten, k, n)
! a_zxxyy(1) = xyz_ExtQMixB_dlon2lat2(isten, jsten, k, n)
a_z(2) = xyz_ExtQMixB(isten+1, jsten, k, n)
a_zx(2) = xyz_ExtQMixB_dlon(isten+1, jsten, k, n)
a_zy(2) = xyz_ExtQMixB_dlat(isten+1, jsten, k, n)
a_zxy(2) = xyz_ExtQMixB_dlonlat(isten+1, jsten, k, n)
! a_zxx(2) = xyz_ExtQMixB_dlon2(isten+1, jsten, k, n)
! a_zyy(2) = xyz_ExtQMixB_dlat2(isten+1, jsten, k, n)
! a_zxxy(2) = xyz_ExtQMixB_dlon2lat(isten+1, jsten, k, n)
! a_zxyy(2) = xyz_ExtQMixB_dlonlat2(isten+1, jsten, k, n)
! a_zxxyy(2) = xyz_ExtQMixB_dlon2lat2(isten+1, jsten, k, n)
a_z(3) = xyz_ExtQMixB(isten+1, jsten+1, k, n)
a_zx(3) = xyz_ExtQMixB_dlon(isten+1, jsten+1, k, n)
a_zy(3) = xyz_ExtQMixB_dlat(isten+1, jsten+1, k, n)
a_zxy(3) = xyz_ExtQMixB_dlonlat(isten+1, jsten+1, k, n)
! a_zxx(3) = xyz_ExtQMixB_dlon2(isten+1, jsten+1, k, n)
! a_zyy(3) = xyz_ExtQMixB_dlat2(isten+1, jsten+1, k, n)
! a_zxxy(3) = xyz_ExtQMixB_dlon2lat(isten+1, jsten+1, k, n)
! a_zxyy(3) = xyz_ExtQMixB_dlonlat2(isten+1, jsten+1, k, n)
! a_zxxyy(3) = xyz_ExtQMixB_dlon2lat2(isten+1, jsten+1, k, n)
a_z(4) = xyz_ExtQMixB(isten, jsten+1, k, n)
a_zx(4) = xyz_ExtQMixB_dlon(isten, jsten+1, k, n)
a_zy(4) = xyz_ExtQMixB_dlat(isten, jsten+1, k, n)
a_zxy(4) = xyz_ExtQMixB_dlonlat(isten, jsten+1, k, n)
! a_zxx(4) = xyz_ExtQMixB_dlon2(isten, jsten+1, k, n)
! a_zyy(4) = xyz_ExtQMixB_dlat2(isten, jsten+1, k, n)
! a_zxxy(4) = xyz_ExtQMixB_dlon2lat(isten, jsten+1, k, n)
! a_zxyy(4) = xyz_ExtQMixB_dlonlat2(isten, jsten+1, k, n)
! a_zxxyy(4) = xyz_ExtQMixB_dlon2lat2(isten, jsten+1, k, n)
DeltaLat = y_ExtLat(jsten+1) - y_ExtLat(jsten)
!方向分離型2次元エルミート3次補間
xyz_QMixA(i,j,k,n) = SLTTHerIntCub2D(a_z(1:4), a_zx(1:4), a_zy(1:5), a_zxy(1:4), DeltaLon, DeltaLat, xyz_DPLon(i, j, k)-x_ExtLon(isten), xyz_DPLat(i, j, k)-y_ExtLat(jsten) )
!方向分離型2次元エルミート5次補間
! xyz_QMixA(i,j,k) = hqint2D(a_z, a_zx, a_zy, a_zxy, a_zxx, a_zyy, a_zxxy, a_zxyy, a_zxxyy, deltalon, deltalat, &
! & xyz_DPLon(i, j, k)-x_ExtLon(isten), xyz_DPLat(i, j, k)-y_ExtLat(jsten) )
enddo
case DEFAULT
call MessageNotify( 'E', module_name, 'GIVE CORRECT KEYWORD FOR <SLTTIntHor> IN NAMELIST.' )
end select
enddo
enddo
enddo
end subroutine SLTTIrrHerIntK13
| Function : | |
| f1 : | real(8), intent(in) |
| f2 : | real(8), intent(in) |
| f3 : | real(8), intent(in) |
| f4 : | real(8), intent(in) |
| g2 : | real(8), intent(in) |
| g3 : | real(8), intent(in) |
| dx21 : | real(8), intent(in) |
| dx23 : | real(8), intent(in) |
| dx24 : | real(8), intent(in) |
変則エルミート5次補間(2階微分不使用) 1D Hermite Quintic Interpolation 不等間隔格子の場合 non-equal separation
1---2--x-3---4
f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔 f:function value, g:derivative dx21: lon(1)-lon(2), dx23: lon(3)-lon(2), dx24: lon(4)-lon(2), f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0 f1 = f(dx21), f2 = f(0), f3 = f(dx23), f4 = f(dx24)
function SLTTIrrHerIntQui1DNonUni(f1, f2, f3, f4, g2, g3, dx21, dx23, dx24, Xi) result (fout)
! 変則エルミート5次補間(2階微分不使用)
! 1D Hermite Quintic Interpolation
! 不等間隔格子の場合
! non-equal separation
! 1---2--x-3---4
! f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔
! f:function value, g:derivative
! dx21: lon(1)-lon(2), dx23: lon(3)-lon(2), dx24: lon(4)-lon(2),
! f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0
! f1 = f(dx21), f2 = f(0), f3 = f(dx23), f4 = f(dx24)
implicit none
real(8), intent(in) :: f1, f2, f3, f4, g2, g3
real(8), intent(in) :: dx21, dx23, dx24, Xi
real(8) :: fout, r, t
!------Internal variables-------
real(8):: a(0:5)
real(8):: indx
real(8):: Y1, Y3, Y4, Z3, Xi2
integer :: n
! 計算効率化のため、dx21, dx23, dx24 を dx23 で正規化する。
! このとき、1階微分値は × dx23 する必要がある。
r = dx21/dx23
t = dx24/dx23
a(0) = f2
a(1) = g2*dx23
Y1 = f1 - a(0) -a(1)*r
Y3 = f3 - a(0) -a(1)
Y4 = f4 - a(0) -a(1)*t
Z3 = g3*dx23 - a(1)
! 連立方程式
! a(5) + a(4) + a(3) + a(2) = Y3
! a(5)r^5 + a(4)r^4 + a(3)r^3 + a(2)r^2 = Y1
! a(5)t^5 + a(4)t^4 + a(3)t^3 + a(2)t^2 = Y4
! 5a(5) + 4a(4) + 3a(3) + 2a(2) = Z3
! の解は
a(5) = Y1/( (r-1.0_DP)*(r-1.0_DP)*r*r*(r-t) ) - Y4 / ( (t-1.0_DP)*(t-1.0_DP)*t*t*(r-t) ) - (4.0_DP + 2.0_DP*r*t -3.0_DP*(r+t))*Y3 / ( (r-1.0_DP)*(r-1.0_DP)*(t-1.0_DP)*(t-1.0_DP) ) + Z3 / ( (r-1.0_DP)*(t-1.0_DP) )
a(4) = -(t+2.0_DP)*Y1 / ((r-1.0_DP)*(r-1.0_DP)*r*r*(r-t) ) +(r+2.0_DP)*Y4 / ((t-1.0_DP)*(t-1.0_DP)*t*t*(r-t) ) +(5.0_DP - 3.0_DP*(r*r + r*t + t*t) +2.0_DP*r*t*(r+t))*Y3 / ( (r-1.0_DP)*(r-1.0_DP)*(t-1.0_DP)*(t-1.0_DP) ) -(r+t+1.0_DP)*Z3/((r-1.0_DP)*(t-1.0_DP))
a(3) = -2.0_DP*Y3 + Z3 -3.0_DP*a(5) - 2.0_DP*a(4)
a(2) = Y3 - a(5) - a(4) - a(3)
Xi2 = Xi/dx23
!fout = a(5)*Xi2*Xi2*Xi2*Xi2*Xi2 + a(4)*Xi2*Xi2*Xi2*Xi2 &
!& + a(3)*Xi2*Xi2*Xi2 + a(2)*Xi2*Xi2 + a(1)*Xi2 + a(0)
fout = (((((a(5)*Xi2 + a(4))*Xi2+ a(3))*Xi2)+ a(2))*Xi2 + a(1))*Xi2 + a(0)
! Monotonic filter
#ifdef SLTTFULLMONOTONIC
fout = min(max(f2,f3), max(min(f2,f3), fout))
#elif SLTT2D1DMONOTONIC
! Do nothing
#else
if ((f2 - f1)*(f4 - f3)>=0.0_DP) then
fout = min(max(f2,f3), max(min(f2,f3), fout))
endif
#endif
end function SLTTIrrHerIntQui1DNonUni
| Function : | |
| f1 : | real(DP), intent(in) |
| f2 : | real(DP), intent(in) |
| f3 : | real(DP), intent(in) |
| f4 : | real(DP), intent(in) |
| g2 : | real(DP), intent(in) |
| g3 : | real(DP), intent(in) |
| dx : | real(DP), intent(in) |
変則エルミート5次補間(2階微分不使用) 1D Hermite Quintic Interpolation (without 2nd derivatives) 等間隔格子の場合 equal separation
1---2--x-3---4
f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔 f:function value, g:derivative, dx:equal separation of each point, Xi:distance between 2 and x f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0 f1 = f(-X), f2 = f(0), f3 = f(X), f4 = f(2X)
function SLTTIrrHerIntQui1DUni(f1, f2, f3, f4, g2, g3, dx, Xi) result (fout)
! 変則エルミート5次補間(2階微分不使用)
! 1D Hermite Quintic Interpolation (without 2nd derivatives)
! 等間隔格子の場合
! equal separation
! 1---2--x-3---4
! f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔
! f:function value, g:derivative,
! dx:equal separation of each point, Xi:distance between 2 and x
! f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0
! f1 = f(-X), f2 = f(0), f3 = f(X), f4 = f(2X)
implicit none
real(DP), intent(in) :: f1, f2, f3, f4, g2, g3
real(DP), intent(in) :: dx, Xi
real(DP) :: fout
!------internal variables-------
real(DP):: a(0:5)
real(DP):: indx
indx = 1.0_DP/dx
a(0) = f2
a(1) = g2
a(5) = (0.75_DP*f3 - (f1 - f4)/12.0_DP -0.5_DP*( g3 + a(1))*dx -0.75_DP*a(0))*indx**5
a(3) = -a(5)*dx*dx - a(1)*indx*indx + (f3 - f1)*0.5_DP*indx**3
a(4) = ( (g3 + a(1))*0.5_DP*dx - f3 +a(0) )*indx**4 - 1.5_DP*a(5)*dx - 0.5_DP*a(3)*indx
a(2) = ( (f3 + f1)*0.5_DP -a(0))*indx*indx -a(4)*dx*dx
!fout = a(5)*Xi*Xi*Xi*Xi*Xi + a(4)*Xi*Xi*Xi*Xi &
!& + a(3)*Xi*Xi*Xi + a(2)*Xi*Xi + a(1)*Xi + a(0)
fout = (((((a(5)*Xi + a(4))*Xi+ a(3))*Xi)+ a(2))*Xi + a(1))*Xi + a(0)
! Monotonic filter
#ifdef SLTTFULLMONOTONIC
fout = min(max(f2,f3), max(min(f2,f3), fout))
#elif SLTT2D1DMONOTONIC
! Do nothing
#else
if ((f2 - f1)*(f4 - f3)>=0.0_DP) then
fout = min(max(f2,f3), max(min(f2,f3), fout))
endif
#endif
end function SLTTIrrHerIntQui1DUni
| Subroutine : | |||
| iexmin : | integer , intent(in ) | ||
| iexmax : | integer , intent(in ) | ||
| jexmin : | integer , intent(in ) | ||
| jexmax : | integer , intent(in ) | ||
| x_ExtLon(iexmin:iexmax) : | real(DP), intent(in )
| ||
| y_ExtLat(jexmin:jexmax) : | real(DP), intent(in )
| ||
| xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyzf_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
| xyzf_QMixA( 0:imax-1 , 1:jmax/2 , 1:kmax, 1:ncmax) : | real(DP), intent(out)
|
水平方向の2次元補間。 2D linear interpolation
subroutine SLTTIrrLinInt( iexmin, iexmax, jexmin, jexmax, x_ExtLon, y_ExtLat, xyz_DPLon, xyz_DPLat, xyzf_ExtQMixB, xyzf_QMixA )
! 水平方向の2次元補間。
! 2D linear interpolation
use mpi_wrapper, only : myrank
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP), intent(in ) :: x_ExtLon(iexmin:iexmax)
! 経度の拡張配列
! Extended array of Lon
real(DP), intent(in ) :: y_ExtLat(jexmin:jexmax)
! 緯度の拡張配列
! Extended array of Lat
real(DP), intent(in ) :: xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の経度
! Lon at departure point
real(DP), intent(in ) :: xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の緯度
! Lat at departure point
real(DP), intent(in ) :: xyzf_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の拡張配列
! Extended array of mix ration of tracers
real(DP), intent(out) :: xyzf_QMixA ( 0:imax-1 , 1:jmax/2 , 1:kmax, 1:ncmax)
! 次ステップの物質混合比
! Mix ration of tracers at next time-step
real(DP) :: DeltaLat ! 緯度グリッド幅; grid width in meridional direction
integer:: i ! 東西方向に回る DO ループ用作業変数
! Work variables for DO loop in zonal direction
integer:: j ! 南北方向に回る DO ループ用作業変数
! Work variables for DO loop in meridional direction
integer:: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer:: n ! 組成方向に回る DO ループ用作業変数
! Work variables for DO loop in number of composition
integer:: ii
integer:: jj
integer :: isten ! 上流点を囲む4格子点の南西の点の座標番号(東西方向)
! Youngest index of grid points around the departure point (i-direction)
integer :: jsten ! 上流点を囲む4格子点の南西の点の座標番号(南北方向)
! Youngest index of grid points around the departure point (j-direction)
real(DP) :: xy_Z(0:1,0:1) ! 上流点を囲む 4 格子点上の混合比を格納する作業変数
! Work variable containing mixing ratio at 4 grid points around DP
real(DP) :: y_Z(0:1) ! 上流点を囲む 2 格子点上の混合比を格納する作業変数
! Work variable containing mixing ratio at 2 grid points in latitudinal direction
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
! 上流点を囲む4点を探す
! Determine four grid points around the departure point
isten = int(xyz_DPLon(i,j,k)*InvDeltaLon)
do jj = jexmin, jexmax
if (y_ExtLat(jj) > xyz_DPLat(i, j, k)) then
jsten = jj-1
exit
endif
enddo
!MPIに対応できない↓
! jsten = int(xyz_DPLat(i,j,k)*in_deltalat) + ns + 1
! if (y_ExtLat(jsten) > xyz_DPLat(i, j, k)) then
! jsten = jsten - 1
! endif
! Check indices
if ( ( isten < iexmin ) .or. ( isten > iexmax ) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for linear interporation ' // 'in longitudinal direction : Rank %d, i = %d.', i = (/ myrank, isten /) )
end if
if ( ( jsten < jexmin ) .or. ( jsten > jexmax ) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for linear interporation ' // 'in latitudinal direction : Rank %d, j = %d.', i = (/ myrank, jsten /) )
end if
do n = 1, ncmax
do jj = 0, 1
do ii = 0, 1
xy_Z(ii,jj) = xyzf_ExtQMixB(isten+ii,jsten+jj,k,n)
end do
end do
DeltaLat = y_ExtLat(jsten+1) - y_ExtLat(jsten)
do jj = 0, 1
y_Z(jj) = ( xy_Z(1,jj) - xy_Z(0,jj) ) / DeltaLon * ( xyz_DPLon(i,j,k) - x_ExtLon(isten) ) + xy_Z(0,jj)
end do
xyzf_QMixA(i,j,k,n) = ( y_Z(1) - y_Z(0) ) / DeltaLat * ( xyz_DPLat(i,j,k) - y_ExtLat(jsten) ) + y_Z(0)
end do
end do
end do
end do
end subroutine SLTTIrrLinInt
| Subroutine : | |
| iexmin : | integer , intent(in ) |
| iexmax : | integer , intent(in ) |
| jexmin : | integer , intent(in ) |
| jexmax : | integer , intent(in ) |
| x_ExtLon(iexmin:iexmax) : | real(DP), intent(in ) |
| y_ExtLat(jexmin:jexmax) : | real(DP), intent(in ) |
| xyz_MPLon(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in ) |
| xyz_MPLat(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in ) |
| xyz_ii(0:imax-1, 1:jmax/2, 1:kmax) : | integer , intent(out) |
| xyz_jj(0:imax-1, 1:jmax/2, 1:kmax) : | integer , intent(out) |
| xyza_lcifx(0:imax-1, 1:jmax/2, 1:kmax, -1:2) : | real(DP), intent(out) |
| xyza_lcify(0:imax-1, 1:jmax/2, 1:kmax, -1:2) : | real(DP), intent(out) |
水平2次元ラグランジュ3次補間の係数計算 Calculation of factors for 2D Lagrangian cubic interpolation
subroutine SLTTLagIntCubCalcFactHor( iexmin, iexmax, jexmin, jexmax, x_ExtLon, y_ExtLat, xyz_MPLon, xyz_MPLat, xyz_ii, xyz_jj, xyza_lcifx, xyza_lcify )
! 水平2次元ラグランジュ3次補間の係数計算
! Calculation of factors for 2D Lagrangian cubic interpolation
use sltt_const , only : PIx2
use mpi_wrapper, only : myrank
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP), intent(in ) :: x_ExtLon(iexmin:iexmax)
real(DP), intent(in ) :: y_ExtLat(jexmin:jexmax)
real(DP), intent(in ) :: xyz_MPLon(0:imax-1, 1:jmax/2, 1:kmax)
real(DP), intent(in ) :: xyz_MPLat(0:imax-1, 1:jmax/2, 1:kmax)
integer , intent(out) :: xyz_ii(0:imax-1, 1:jmax/2, 1:kmax)
integer , intent(out) :: xyz_jj(0:imax-1, 1:jmax/2, 1:kmax)
real(DP), intent(out) :: xyza_lcifx(0:imax-1, 1:jmax/2, 1:kmax, -1:2)
real(DP), intent(out) :: xyza_lcify(0:imax-1, 1:jmax/2, 1:kmax, -1:2)
!
! local variables
!
integer :: ii
integer :: jj
integer :: i, j, k, j2
! integer :: ns ! 南北半球の違いに対応するための変数
! real(DP) :: in_deltalat
!
!if (y_ExtLat(jmax/4) > 0) then
! ns = 0
!else
! ns = jmax/2 - 1
!endif
!in_deltalat = 1.0_DP/(y_ExtLat(jmax/4) - y_ExtLat(jmax/4-1))
xyz_ii = int( xyz_MPLon / ( PIx2 / imax ) )
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
! comment out 2015/04/10
!!$ if( xyz_MPLat(i,j,k) > y_ExtLat(j) ) then
!!$ j_search_1 : do j2 = j+1, jexmax
!!$ if( y_ExtLat(j2) > xyz_MPLat(i,j,k) ) exit j_search_1
!!$ end do j_search_1
!!$ xyz_jj(i,j,k) = j2 - 1
!!$ if ( xyz_jj(i,j,k) > jexmax-2 ) xyz_jj(i,j,k) = jexmax-2
!!$ else
!!$ j_search_2 : do j2 = j-1, jexmin, -1
!!$ if( y_ExtLat(j2) < xyz_MPLat(i,j,k) ) exit j_search_2
!!$ end do j_search_2
!!$ xyz_jj(i,j,k) = j2
!!$ if ( xyz_jj(i,j,k) < jexmin+1 ) xyz_jj(i,j,k) = jexmin+1
!!$ end if
! trial
if( xyz_MPLat(i,j,k) > y_ExtLat(j) ) then
j_search_1 : do j2 = j+1, jexmax
if( y_ExtLat(j2) > xyz_MPLat(i,j,k) ) exit j_search_1
end do j_search_1
xyz_jj(i,j,k) = j2 - 1
else
j_search_2 : do j2 = j-1, jexmin, -1
if( y_ExtLat(j2) < xyz_MPLat(i,j,k) ) exit j_search_2
end do j_search_2
xyz_jj(i,j,k) = j2
end if
! xyz_jj(i,j,k) = int(xyz_MPLat(i,j,k)*in_deltalat) + ns + 1
! if (y_ExtLat(xyz_jj(i,j,k)) > xyz_MPLat(i, j, k)) then
! xyz_jj(i,j,k) = xyz_jj(i,j,k) - 1
! endif
end do
end do
end do
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
ii = xyz_ii(i,j,k)
if ( ii-1 < iexmin ) then
call MessageNotify( 'E', module_name, 'Longitudinal point for interporation factor calculation ' // 'is is out of range of an extended array : Rank %d, (i,j,k) = (%d,%d,%d).', i = (/ myrank, i, j, k /) )
end if
if ( ii+2 > iexmax ) then
call MessageNotify( 'E', module_name, 'Longitudinal point for interporation factor calculation ' // 'is is out of range of an extended array : Rank %d, (i,j,k) = (%d,%d,%d).', i = (/ myrank, i, j, k /) )
end if
jj = xyz_jj(i,j,k)
if ( jj-1 < jexmin ) then
call MessageNotify( 'E', module_name, 'Latitudinal point for interporation factor calculation ' // 'is is out of range of an extended array : Rank %d, (i,j,k) = (%d,%d,%d).', i = (/ myrank, i, j, k /) )
end if
if ( jj+2 > jexmax ) then
call MessageNotify( 'E', module_name, 'Latitudinal point for interporation factor calculation ' // 'is is out of range of an extended array : Rank %d, (i,j,k) = (%d,%d,%d).', i = (/ myrank, i, j, k /) )
end if
end do
end do
end do
!
! calculation of Lagrange cubic interpolation factor
! for longitudinal direction
!
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
ii = xyz_ii(i,j,k)
jj = xyz_jj(i,j,k)
xyza_lcifx(i,j,k,-1) = ( xyz_MPLon(i,j,k) - x_ExtLon(ii ) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+1) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+2) ) * (-InvDeltaLon**3)/6.0_DP ! economical
! & / ( ( x_ExtLon(ii-1) - x_ExtLon(ii ) ) &
! & * ( x_ExtLon(ii-1) - x_ExtLon(ii+1) ) &
! & * ( x_ExtLon(ii-1) - x_ExtLon(ii+2) ) )
xyza_lcifx(i,j,k, 0) = ( xyz_MPLon(i,j,k) - x_ExtLon(ii-1) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+1) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+2) ) * (0.5_DP*InvDeltaLon**3) ! economical
! & / ( ( x_ExtLon(ii ) - x_ExtLon(ii-1) ) &
! & * ( x_ExtLon(ii ) - x_ExtLon(ii+1) ) &
! & * ( x_ExtLon(ii ) - x_ExtLon(ii+2) ) )
xyza_lcifx(i,j,k, 1) = ( xyz_MPLon(i,j,k) - x_ExtLon(ii-1) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii ) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+2) ) * (-0.5_DP*InvDeltaLon**3) ! economical
! & / ( ( x_ExtLon(ii+1) - x_ExtLon(ii-1) ) &
! & * ( x_ExtLon(ii+1) - x_ExtLon(ii ) ) &
! & * ( x_ExtLon(ii+1) - x_ExtLon(ii+2) ) )
xyza_lcifx(i,j,k, 2) = ( xyz_MPLon(i,j,k) - x_ExtLon(ii-1) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii ) ) * ( xyz_MPLon(i,j,k) - x_ExtLon(ii+1) ) * (InvDeltaLon**3)/6.0_DP ! economical
! & / ( ( x_ExtLon(ii+2) - x_ExtLon(ii-1) ) &
! & * ( x_ExtLon(ii+2) - x_ExtLon(ii ) ) &
! & * ( x_ExtLon(ii+2) - x_ExtLon(ii+1) ) )
xyza_lcify(i,j,k,-1) = ( xyz_MPLat(i,j,k) - y_ExtLat(jj ) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+1) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+2) ) / ( ( y_ExtLat(jj-1) - y_ExtLat(jj ) ) * ( y_ExtLat(jj-1) - y_ExtLat(jj+1) ) * ( y_ExtLat(jj-1) - y_ExtLat(jj+2) ) )
xyza_lcify(i,j,k, 0) = ( xyz_MPLat(i,j,k) - y_ExtLat(jj-1) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+1) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+2) ) / ( ( y_ExtLat(jj ) - y_ExtLat(jj-1) ) * ( y_ExtLat(jj ) - y_ExtLat(jj+1) ) * ( y_ExtLat(jj ) - y_ExtLat(jj+2) ) )
xyza_lcify(i,j,k, 1) = ( xyz_MPLat(i,j,k) - y_ExtLat(jj-1) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj ) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+2) ) / ( ( y_ExtLat(jj+1) - y_ExtLat(jj-1) ) * ( y_ExtLat(jj+1) - y_ExtLat(jj ) ) * ( y_ExtLat(jj+1) - y_ExtLat(jj+2) ) )
xyza_lcify(i,j,k, 2) = ( xyz_MPLat(i,j,k) - y_ExtLat(jj-1) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj ) ) * ( xyz_MPLat(i,j,k) - y_ExtLat(jj+1) ) / ( ( y_ExtLat(jj+2) - y_ExtLat(jj-1) ) * ( y_ExtLat(jj+2) - y_ExtLat(jj ) ) * ( y_ExtLat(jj+2) - y_ExtLat(jj+1) ) )
end do
end do
end do
end subroutine SLTTLagIntCubCalcFactHor
| Subroutine : | |
| xyz_DPSigma(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyza_lcifz(0:imax-1, 1:jmax, 1:kmax, -1:2) : | real(DP), intent(out) |
| xyz_kk(0:imax-1, 1:jmax, 1:kmax) : | integer , intent(out) |
鉛直1次元ラグランジュ3次補間のための係数計算 Calculation of factors for 1D Lagrangian cubic interpolation
subroutine SLTTLagIntCubCalcFactVer( xyz_DPSigma, xyza_lcifz, xyz_kk )
! 鉛直1次元ラグランジュ3次補間のための係数計算
! Calculation of factors for 1D Lagrangian cubic interpolation
! 座標データ設定
! Axes data settings
!
use axesset, only : z_Sigma
real(DP), intent(in ) :: xyz_DPSigma (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out) :: xyza_lcifz(0:imax-1, 1:jmax, 1:kmax, -1:2)
integer , intent(out) :: xyz_kk (0:imax-1, 1:jmax, 1:kmax)
!
! local variables
!
integer :: i
integer :: j
integer :: k
integer :: kk
integer :: k2
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
!
! Routine for dcpam
!
! Departure points, xyz_DPSigma(:,:,k), must be located between
! z_Sigma(kk) > xyz_DPSigma(k) > z_Sigma(kk+1).
! Further, 2 <= kk <= kmax-2.
!
!
! economical method
!
if( xyz_DPSigma(i,j,k) > z_Sigma(k) ) then
k_search_1 : do k2 = k, 2, -1
if( z_Sigma(k2) > xyz_DPSigma(i,j,k) ) exit k_search_1
end do k_search_1
xyz_kk(i,j,k) = k2
else
k_search_2 : do k2 = min( k+1, kmax ), kmax
if( z_Sigma(k2) < xyz_DPSigma(i,j,k) ) exit k_search_2
end do k_search_2
xyz_kk(i,j,k) = k2 - 1
end if
xyz_kk(i,j,k) = min( max( xyz_kk(i,j,k), 2 ), kmax-2 )
! xyz_kk(i,j,k) = min( max( xyz_kk(i,j,k), 1 ), kmax-1 )
end do
end do
end do
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
kk = xyz_kk(i,j,k)
xyza_lcifz(i,j,k,-1) = ( xyz_DPSigma(i,j,k) - z_Sigma(kk ) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+1) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+2) ) / ( ( z_Sigma(kk-1) - z_Sigma(kk ) ) * ( z_Sigma(kk-1) - z_Sigma(kk+1) ) * ( z_Sigma(kk-1) - z_Sigma(kk+2) ) )
xyza_lcifz(i,j,k, 0) = ( xyz_DPSigma(i,j,k) - z_Sigma(kk-1) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+1) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+2) ) / ( ( z_Sigma(kk ) - z_Sigma(kk-1) ) * ( z_Sigma(kk ) - z_Sigma(kk+1) ) * ( z_Sigma(kk ) - z_Sigma(kk+2) ) )
xyza_lcifz(i,j,k, 1) = ( xyz_DPSigma(i,j,k) - z_Sigma(kk-1) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk ) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+2) ) / ( ( z_Sigma(kk+1) - z_Sigma(kk-1) ) * ( z_Sigma(kk+1) - z_Sigma(kk ) ) * ( z_Sigma(kk+1) - z_Sigma(kk+2) ) )
xyza_lcifz(i,j,k, 2) = ( xyz_DPSigma(i,j,k) - z_Sigma(kk-1) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk ) ) * ( xyz_DPSigma(i,j,k) - z_Sigma(kk+1) ) / ( ( z_Sigma(kk+2) - z_Sigma(kk-1) ) * ( z_Sigma(kk+2) - z_Sigma(kk ) ) * ( z_Sigma(kk+2) - z_Sigma(kk+1) ) )
end do
end do
end do
end subroutine SLTTLagIntCubCalcFactVer
| Subroutine : | |
| iexmin : | integer , intent(in ) |
| iexmax : | integer , intent(in ) |
| jexmin : | integer , intent(in ) |
| jexmax : | integer , intent(in ) |
| xyz_ii(0:imax-1, 1:jmax/2, 1:kmax) : | integer , intent(in ) |
| xyz_jj(0:imax-1, 1:jmax/2, 1:kmax) : | integer , intent(in ) |
| xyza_lcifx( 0:imax-1, 1:jmax/2, 1:kmax, -1:2) : | real(DP), intent(in ) |
| xyza_lcify( 0:imax-1, 1:jmax/2, 1:kmax, -1:2) : | real(DP), intent(in ) |
| xyz_ExtArr(iexmin:iexmax, jexmin:jexmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_MPArr( 0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(out) |
水平2次元ラグランジュ3次補間 2D Lagrangian cubic interpolation
subroutine SLTTLagIntCubIntHor( iexmin, iexmax, jexmin, jexmax, xyz_ii, xyz_jj, xyza_lcifx, xyza_lcify, xyz_ExtArr, xyz_MPArr )
! 水平2次元ラグランジュ3次補間
! 2D Lagrangian cubic interpolation
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
integer , intent(in ) :: xyz_ii(0:imax-1, 1:jmax/2, 1:kmax)
integer , intent(in ) :: xyz_jj(0:imax-1, 1:jmax/2, 1:kmax)
real(DP), intent(in ) :: xyza_lcifx( 0:imax-1, 1:jmax/2, 1:kmax, -1:2)
real(DP), intent(in ) :: xyza_lcify( 0:imax-1, 1:jmax/2, 1:kmax, -1:2)
real(DP), intent(in ) :: xyz_ExtArr(iexmin:iexmax, jexmin:jexmax, 1:kmax)
real(DP), intent(out) :: xyz_MPArr ( 0:imax-1, 1:jmax/2, 1:kmax)
!
! local variables
!
integer :: ii
integer :: jj
integer :: kk
integer :: i, j, k
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
ii = xyz_ii(i,j,k)
jj = xyz_jj(i,j,k)
kk = k
xyz_MPArr(i,j,k) = xyza_lcify(i,j,k,-1) * ( xyza_lcifx(i,j,k,-1) * xyz_ExtArr(ii-1,jj-1,kk) + xyza_lcifx(i,j,k, 0) * xyz_ExtArr(ii ,jj-1,kk) + xyza_lcifx(i,j,k, 1) * xyz_ExtArr(ii+1,jj-1,kk) + xyza_lcifx(i,j,k, 2) * xyz_ExtArr(ii+2,jj-1,kk) ) + xyza_lcify(i,j,k, 0) * ( xyza_lcifx(i,j,k,-1) * xyz_ExtArr(ii-1,jj ,kk) + xyza_lcifx(i,j,k, 0) * xyz_ExtArr(ii ,jj ,kk) + xyza_lcifx(i,j,k, 1) * xyz_ExtArr(ii+1,jj ,kk) + xyza_lcifx(i,j,k, 2) * xyz_ExtArr(ii+2,jj ,kk) ) + xyza_lcify(i,j,k, 1) * ( xyza_lcifx(i,j,k,-1) * xyz_ExtArr(ii-1,jj+1,kk) + xyza_lcifx(i,j,k, 0) * xyz_ExtArr(ii ,jj+1,kk) + xyza_lcifx(i,j,k, 1) * xyz_ExtArr(ii+1,jj+1,kk) + xyza_lcifx(i,j,k, 2) * xyz_ExtArr(ii+2,jj+1,kk) ) + xyza_lcify(i,j,k, 2) * ( xyza_lcifx(i,j,k,-1) * xyz_ExtArr(ii-1,jj+2,kk) + xyza_lcifx(i,j,k, 0) * xyz_ExtArr(ii ,jj+2,kk) + xyza_lcifx(i,j,k, 1) * xyz_ExtArr(ii+1,jj+2,kk) + xyza_lcifx(i,j,k, 2) * xyz_ExtArr(ii+2,jj+2,kk) )
end do
end do
end do
end subroutine SLTTLagIntCubIntHor
| Subroutine : | |
| xyz_Arr(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyza_lcifz(0:imax-1, 1:jmax, 1:kmax, -1:2) : | real(DP), intent(in ) |
| xyz_kk(0:imax-1, 1:jmax, 1:kmax) : | integer , intent(in ) |
| xyz_ArrA(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out) |
鉛直1次元ラグランジュ3次補間 1D Lagrangian cubic interpolation
subroutine SLTTLagIntCubIntVer( xyz_Arr, xyza_lcifz, xyz_kk, xyz_ArrA )
! 鉛直1次元ラグランジュ3次補間
! 1D Lagrangian cubic interpolation
real(DP), intent(in ) :: xyz_Arr (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyza_lcifz(0:imax-1, 1:jmax, 1:kmax, -1:2)
integer , intent(in ) :: xyz_kk (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out) :: xyz_ArrA (0:imax-1, 1:jmax, 1:kmax)
!
! local variables
!
integer :: i
integer :: j
integer :: k
integer :: kk
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
kk = xyz_kk(i,j,k)
xyz_ArrA(i,j,k) = xyza_lcifz(i,j,k,-1) * xyz_Arr(i,j,kk-1) + xyza_lcifz(i,j,k, 0) * xyz_Arr(i,j,kk ) + xyza_lcifz(i,j,k, 1) * xyz_Arr(i,j,kk+1) + xyza_lcifz(i,j,k, 2) * xyz_Arr(i,j,kk+2)
end do
end do
end do
end subroutine SLTTLagIntCubIntVer
| Subroutine : | |||
| iexmin : | integer , intent(in ) | ||
| iexmax : | integer , intent(in ) | ||
| jexmin : | integer , intent(in ) | ||
| jexmax : | integer , intent(in ) | ||
| x_ExtLon(iexmin:iexmax) : | real(DP), intent(in )
| ||
| y_ExtLat(jexmin:jexmax) : | real(DP), intent(in )
| ||
| xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP), intent(in )
| ||
| xyzf_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
| xyzf_QMixMinA( 0:imax-1, 1:jmax/2, 1:kmax, 1:ncmax) : | real(DP), intent(out)
| ||
| xyzf_QMixMaxA( 0:imax-1, 1:jmax/2, 1:kmax, 1:ncmax) : | real(DP), intent(out)
|
水平方向の2次元補間。 2D linear interpolation
subroutine SLTTLagIntHorMaxMin( iexmin, iexmax, jexmin, jexmax, x_ExtLon, y_ExtLat, xyz_DPLon, xyz_DPLat, xyzf_ExtQMixB, xyzf_QMixMinA, xyzf_QMixMaxA )
! 水平方向の2次元補間。
! 2D linear interpolation
use mpi_wrapper, only : myrank
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP), intent(in ) :: x_ExtLon(iexmin:iexmax)
! 経度の拡張配列
! Extended array of Lon
real(DP), intent(in ) :: y_ExtLat(jexmin:jexmax)
! 緯度の拡張配列
! Extended array of Lat
real(DP), intent(in ) :: xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の経度
! Lon at departure point
real(DP), intent(in ) :: xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の緯度
! Lat at departure point
real(DP), intent(in ) :: xyzf_ExtQMixB(iexmin:iexmax, jexmin:jexmax, 1:kmax, 1:ncmax)
! 物質混合比の拡張配列
! Extended array of mix ration of tracers
real(DP), intent(out) :: xyzf_QMixMinA( 0:imax-1, 1:jmax/2, 1:kmax, 1:ncmax)
! 上流点を囲む 4 格子点の最小値
! Minimum mixing ratio of tracers at 4 grid points
! surrounding a departure point
real(DP), intent(out) :: xyzf_QMixMaxA( 0:imax-1, 1:jmax/2, 1:kmax, 1:ncmax)
! 上流点を囲む 4 格子点の最大値
! Maximum mixing ratio of tracers at 4 grid points
! surrounding a departure point
real(DP) :: DeltaLat ! 緯度グリッド幅; grid width in meridional direction
integer:: i ! 東西方向に回る DO ループ用作業変数
! Work variables for DO loop in zonal direction
integer:: j ! 南北方向に回る DO ループ用作業変数
! Work variables for DO loop in meridional direction
integer:: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer:: n ! 組成方向に回る DO ループ用作業変数
! Work variables for DO loop in number of composition
integer:: ii
integer:: jj
integer :: isten ! 上流点を囲む4格子点の南西の点の座標番号(東西方向)
! Youngest index of grid points around the departure point (i-direction)
integer :: jsten ! 上流点を囲む4格子点の南西の点の座標番号(南北方向)
! Youngest index of grid points around the departure point (j-direction)
real(DP) :: xy_Z(0:1,0:1) ! 上流点を囲む 4 格子点上の混合比を格納する作業変数
! Work variable containing mixing ratio at 4 grid points around DP
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
! 上流点を囲む4点を探す
! Determine four grid points around the departure point
isten = int(xyz_DPLon(i,j,k)*InvDeltaLon)
do jj = jexmin, jexmax
if (y_ExtLat(jj) > xyz_DPLat(i, j, k)) then
jsten = jj-1
exit
endif
enddo
!MPIに対応できない↓
! jsten = int(xyz_DPLat(i,j,k)*in_deltalat) + ns + 1
! if (y_ExtLat(jsten) > xyz_DPLat(i, j, k)) then
! jsten = jsten - 1
! endif
! Check indices
if ( ( isten < iexmin ) .or. ( isten > iexmax ) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for linear interporation ' // 'in longitudinal direction : Rank %d, i = %d.', i = (/ myrank, isten /) )
end if
if ( ( jsten < jexmin ) .or. ( jsten > jexmax ) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for linear interporation ' // 'in latitudinal direction : Rank %d, j = %d.', i = (/ myrank, jsten /) )
end if
do n = 1, ncmax
do jj = 0, 1
do ii = 0, 1
xy_Z(ii,jj) = xyzf_ExtQMixB(isten+ii,jsten+jj,k,n)
end do
end do
xyzf_QMixMinA(i,j,k,n) = min( xy_Z(0,0), xy_Z(1,0), xy_Z(0,1), xy_Z(1,1) )
xyzf_QMixMaxA(i,j,k,n) = max( xy_Z(0,0), xy_Z(1,0), xy_Z(0,1), xy_Z(1,1) )
end do
end do
end do
end do
end subroutine SLTTLagIntHorMaxMin
| Function : | |
| f1 : | real(DP), intent(in) |
| f2 : | real(DP), intent(in) |
| f3 : | real(DP), intent(in) |
| f4 : | real(DP), intent(in) |
| g2 : | real(DP), intent(in) |
| g3 : | real(DP), intent(in) |
変則エルミート5次補間(2階微分不使用) 1D Hermite Quintic Interpolation (without 2nd derivatives) 経度方向(等間隔)専用 equal separation
1---2--x-3---4
f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔 f:function value, g:derivative, dx:equal separation of each point, Xi:distance between 2 and x f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0 f1 = f(-X), f2 = f(0), f3 = f(X), f4 = f(2X)
function SLTTIrrHerIntQui1DUniLon(f1, f2, f3, f4, g2, g3, Xi) result (fout)
! 変則エルミート5次補間(2階微分不使用)
! 1D Hermite Quintic Interpolation (without 2nd derivatives)
! 経度方向(等間隔)専用
! equal separation
! 1---2--x-3---4
! f:関数値、g:微分値、、dx:点の間隔、Xi:点2と補間する点xとの間隔
! f:function value, g:derivative,
! dx:equal separation of each point, Xi:distance between 2 and x
! f(x) = a_5*x^5 + a_4*x^4 + a_3*x^3 + a_2*x^2 + a_1*x + a_0
! f1 = f(-X), f2 = f(0), f3 = f(X), f4 = f(2X)
implicit none
real(DP), intent(in) :: f1, f2, f3, f4, g2, g3
real(DP), intent(in) :: Xi
real(DP) :: fout
!------internal variables-------
real(DP):: a(0:5)
a(0) = f2
a(1) = g2
a(5) = (0.75_DP*f3 - (f1 - f4)/12.0_DP -0.5_DP*( g3 + a(1))*DeltaLon -0.75_DP*a(0))*InvDeltaLon**5
a(3) = -a(5)*DeltaLon*DeltaLon - a(1)*InvDeltaLon*InvDeltaLon + (f3 - f1)*0.5_DP*InvDeltaLon**3
a(4) = ( (g3 + a(1))*0.5_DP*DeltaLon - f3 +a(0) )*InvDeltaLon**4 - 1.5_DP*a(5)*DeltaLon - 0.5_DP*a(3)*InvDeltaLon
a(2) = ( (f3 + f1)*0.5_DP -a(0))*InvDeltaLon*InvDeltaLon -a(4)*DeltaLon*DeltaLon
!fout = a(5)*Xi*Xi*Xi*Xi*Xi + a(4)*Xi*Xi*Xi*Xi &
!& + a(3)*Xi*Xi*Xi + a(2)*Xi*Xi + a(1)*Xi + a(0)
fout = (((((a(5)*Xi + a(4))*Xi+ a(3))*Xi)+ a(2))*Xi + a(1))*Xi + a(0)
! Monotonic filter
#ifdef SLTTFULLMONOTONIC
fout = min(max(f2,f3), max(min(f2,f3), fout))
#elif SLTT2D1DMONOTONIC
! Do nothing
#else
if ((f2 - f1)*(f4 - f3)>=0.0_DP) then
fout = min(max(f2,f3), max(min(f2,f3), fout))
endif
#endif
end function SLTTIrrHerIntQui1DUniLon
| Function : | |
| f : | real(DP), dimension(16), intent(in) |
| fx : | real(DP), dimension(16), intent(in) |
| fy : | real(DP), dimension(16), intent(in) |
| fxy : | real(DP), dimension(16), intent(in) |
| dy21 : | real(DP), intent(in) |
| dy23 : | real(DP), intent(in) |
| dy24 : | real(DP), intent(in) |
| Xix : | real(DP), intent(in) |
2次元変則エルミート5次補間(2階微分不使用) 2D Hermite Quintic Interpolation (without 2nd derivatives)
13-14-d-15--16 | | | | | 9--10-c-11--12 | | x | | 5---6-b-7---8 | | | | | 1---2-a-3---4
Xix:点6と点aとの間隔、Xiy:点aと点Xとの間隔 dy21=lat(5)-lat(1), dy23=lat(5)-lat(9), dy24=lat(5)-lat(13) Xix:distance between 6 and a, Xiy:distance between b and x dy21=lat(5)-lat(1), dy23=lat(5)-lat(9), dy24=lat(5)-lat(13)
function SLTTIrrHerIntQui2DHor(f, fx, fy, fxy, dy21, dy23, dy24, Xix, Xiy) result (fout)
! 2次元変則エルミート5次補間(2階微分不使用)
! 2D Hermite Quintic Interpolation (without 2nd derivatives)
!
! 13-14-d-15--16
! | | | | |
! 9--10-c-11--12
! | | x | |
! 5---6-b-7---8
! | | | | |
! 1---2-a-3---4
!
! Xix:点6と点aとの間隔、Xiy:点aと点Xとの間隔
! dy21=lat(5)-lat(1), dy23=lat(5)-lat(9), dy24=lat(5)-lat(13)
! Xix:distance between 6 and a, Xiy:distance between b and x
! dy21=lat(5)-lat(1), dy23=lat(5)-lat(9), dy24=lat(5)-lat(13)
implicit none
real(DP), dimension(16), intent(in) :: f, fx, fy, fxy
real(DP), intent(in) :: dy21, dy23, dy24, Xix, Xiy
real(DP) :: fout
!------internal variables-------
real(DP) :: fa, fb, fc, fd, fyb, fyc, fya, fyd, lmin, lmax
! 点1-4から点aでの値を求める
! interpolate a from points 1-4
fa = SLTTIrrHerIntQui1DUniLon(f(1), f(2), f(3), f(4), fx(2), fx(3), Xix)
! 点5-8から点bでの値を求める
! interpolate b from points 5-8
fb = SLTTIrrHerIntQui1DUniLon(f(5), f(6), f(7), f(8), fx(6), fx(7), Xix)
fyb = SLTTIrrHerIntQui1DUniLon(fy(5), fy(6), fy(7), fy(8), fxy(6), fxy(7), Xix)
! 点9-12から点cでの値を求める
! interpolate c from points 9-12
fc = SLTTIrrHerIntQui1DUniLon(f(9), f(10), f(11), f(12), fx(10), fx(11), Xix)
fyc = SLTTIrrHerIntQui1DUniLon(fy(9), fy(10), fy(11), fy(12), fxy(10), fxy(11), Xix)
! 点13-16から点dでの値を求める
! interpolate d from points 13-16
fd = SLTTIrrHerIntQui1DUniLon(f(13), f(14), f(15), f(16), fx(14), fx(15), Xix)
! 点a-dから点Xをでの値を求める
! interpolate X from points a-d
fout = SLTTIrrHerIntQui1DNonUni(fa, fb, fc, fd, fyb, fyc, dy21, dy23, dy24, Xiy)
!等間隔格子に近似しても、精度はほとんど落ちない。計算は軽くなる。
!fout = SLTTIrrHerIntQui1DUni(fa, fb, fc, fd, fyb, fyc, dy23, Xiy)
end function SLTTIrrHerIntQui2DHor
| Subroutine : | |||
| SLTTIntHor : | character(*), intent(in ) | ||
| iexmin : | integer , intent(in ) | ||
| iexmax : | integer , intent(in ) | ||
| jexmin : | integer , intent(in ) | ||
| jexmax : | integer , intent(in ) | ||
| y_ExtLat(jexmin:jexmax) : | real(DP) , intent(in )
| ||
| xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP) , intent(in )
|
subroutine SLTTLagIntChkDPLat( SLTTIntHor, iexmin, iexmax, jexmin, jexmax, y_ExtLat, xyz_DPLat )
!
! MPI
!
use mpi_wrapper, only : myrank
! Number of MPI rank
character(*), intent(in ) :: SLTTIntHor
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP) , intent(in ) :: y_ExtLat(jexmin:jexmax)
! 緯度の拡張配列
! Extended array of Lat
real(DP) , intent(in ) :: xyz_DPLat(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の緯度
! Lat of departure point
!
! local variables
!
integer :: jedge
integer :: i
integer :: j
integer :: k
select case (SLTTIntHor)
case ("HQ")
! 方向分離型2次元変則エルミート5次補間; 2D Hermite quintic interpolation
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
jedge = jexmin + 1
if ( xyz_DPLat(i,j,k) < y_ExtLat(jedge) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for latitudinal direction : Rank %d, %f < %f.', i = (/ myrank /), d = (/ xyz_DPLat(i,j,k), y_ExtLat(jedge) /) )
end if
jedge = jexmax - 1
if ( xyz_DPLat(i,j,k) > y_ExtLat(jedge) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for latitudinal direction : Rank %d, %f > %f.', i = (/ myrank /), d = (/ xyz_DPLat(i,j,k), y_ExtLat(jedge) /) )
end if
end do
end do
end do
end select
end subroutine SLTTLagIntChkDPLat
| Subroutine : | |||
| SLTTIntHor : | character(*), intent(in ) | ||
| iexmin : | integer , intent(in ) | ||
| iexmax : | integer , intent(in ) | ||
| jexmin : | integer , intent(in ) | ||
| jexmax : | integer , intent(in ) | ||
| x_ExtLon(iexmin:iexmax) : | real(DP) , intent(in )
| ||
| xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax) : | real(DP) , intent(in )
|
subroutine SLTTLagIntChkDPLon( SLTTIntHor, iexmin, iexmax, jexmin, jexmax, x_ExtLon, xyz_DPLon )
!
! MPI
!
use mpi_wrapper, only : myrank
! Number of MPI rank
character(*), intent(in ) :: SLTTIntHor
integer , intent(in ) :: iexmin
integer , intent(in ) :: iexmax
integer , intent(in ) :: jexmin
integer , intent(in ) :: jexmax
real(DP) , intent(in ) :: x_ExtLon(iexmin:iexmax)
! 緯度の拡張配列
! Extended array of Lat
real(DP) , intent(in ) :: xyz_DPLon(0:imax-1, 1:jmax/2, 1:kmax)
! 上流点の緯度
! Lat of departure point
!
! local variables
!
integer :: iedge
integer :: i
integer :: j
integer :: k
select case (SLTTIntHor)
case ("HQ")
! 方向分離型2次元変則エルミート5次補間; 2D Hermite quintic interpolation
do k = 1, kmax
do j = 1, jmax/2
do i = 0, imax-1
iedge = iexmin + 1
if ( xyz_DPLon(i,j,k) < x_ExtLon(iedge) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for longitudinal direction : Rank %d, %f < %f.', i = (/ myrank /), d = (/ xyz_DPLon(i,j,k), x_ExtLon(iedge) /) )
end if
iedge = iexmax - 1
if ( xyz_DPLon(i,j,k) > x_ExtLon(iedge) ) then
call MessageNotify( 'E', module_name, 'Departure point is out of range of an extended array for longitudinal direction : Rank %d, %f > %f.', i = (/ myrank /), d = (/ xyz_DPLon(i,j,k), x_ExtLon(iedge) /) )
end if
end do
end do
end do
end select
end subroutine SLTTLagIntChkDPLon
| Constant : | |||
| version = ’$Name: $’ // ’$Id: sltt_lagint.F90,v 1.4 2013/09/21 14:42:08 yot Exp $’ : | character(*), parameter
|