湿潤対流調節スキームにより, 温度と比湿を調節.
subroutine MoistConvAdjust( xyz_Temp, xyz_QVap, xy_Rain, xyz_DTempDt, xyz_DQVapDt, xyz_Press, xyr_Press, xyz_DDelLWDtCCP )
!
! 湿潤対流調節スキームにより, 温度と比湿を調節.
!
! Adjust temperature and specific humidity by moist convective adjustment
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: GasRUniv, Grav, GasRDry, CpDry, GasRWet, LatentHeat, EpsV
! $ \epsilon_v $ .
! 水蒸気分子量比.
! Molecular weight of water vapor
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 宣言文 ; Declaration statements
!
implicit none
real(DP), intent(inout):: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! $ T $ . 温度. Temperature
real(DP), intent(inout):: xyz_QVap (0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(inout):: xy_Rain (0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP), intent(inout):: xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax)
! 温度変化率.
! Temperature tendency
real(DP), intent(inout):: xyz_DQVapDt (0:imax-1, 1:jmax, 1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP), intent(in):: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! $ p $ . 気圧 (整数レベル).
! Air pressure (full level)
real(DP), intent(in):: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! $ \hat{p} $ . 気圧 (半整数レベル).
! Air pressure (half level)
real(DP), intent(out), optional:: xyz_DDelLWDtCCP(0:imax-1, 1:jmax, 1:kmax)
! Production rate of liquid water in the layer
! due to condensation in cumulus convection
! parameterization (kg m-2 s-1)
! 作業変数
! Work variables
!
real(DP):: xy_RainCumulus (0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP):: xyz_DTempDtCumulus (0:imax-1, 1:jmax, 1:kmax)
! 温度変化率.
! Temperature tendency
real(DP):: xyz_DQVapDtCumulus (0:imax-1, 1:jmax, 1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP):: xyz_QVapB (0:imax-1, 1:jmax, 1:kmax)
! 調節前の比湿.
! Specific humidity before adjustment
real(DP):: xyz_TempB (0:imax-1, 1:jmax, 1:kmax)
! 調節前の温度.
! Temperature before adjustment
logical:: xy_Adjust (0:imax-1, 1:jmax)
! 今回調節されたか否か?.
! Whether it was adjusted this time or not?
logical:: xy_AdjustB (0:imax-1, 1:jmax)
! 前回調節されたか否か?.
! Whether it was adjusted last time or not?
real(DP):: xyz_DelPress(0:imax-1, 1:jmax, 1:kmax)
! $ \Delta p $
!
real(DP):: xyz_QVapSat (0:imax-1, 1:jmax, 1:kmax)
! 飽和比湿.
! Saturation specific humidity.
real(DP):: xyr_ConvAdjustFactor(0:imax-1, 1:jmax, 0:kmax)
! $ \frac{1}{2} \frac{ R }{Cp}
! \frac{ p_{k} - p_{k+1} }{ p_{k+1/2} } $
real(DP):: TempEquivToExcEne
! Temperature equivalent to the excess moist static energy
! (Moist static energy difference devided by specific heat)
real(DP):: DelQ
real(DP):: DelTempUppLev
! k+1 番目の層における調節による温度の変化量.
! Temperature variation by adjustment at k+1 level
real(DP):: DelTempLowLev
! k 番目の層における調節による温度の変化量.
! Temperature variation by adjustment at k level
real(DP):: DQVapSatDTempUppLev
! $ \DD{q^{*}} (k+1)}{T} $
real(DP):: DQVapSatDTempLowLev
! $ \DD{q^{*}} (k)}{T} $
real(DP):: GamUppLev
! $ \gamma_{k+1} = \frac{L}{C_p} \DP{q^{*}}{T}_{k+1} $
real(DP):: GamLowLev
! $ \gamma_{k} = \frac{L}{C_p} \DP{q^{*}}{T}_{k} $
logical:: Adjust
! 今回全領域において一度でも調節されたか否か?.
! Whether it was adjusted even once in global
! this time or not?
real(DP):: TempLowLevBefAdj ! Variables for check routine
real(DP):: TempUppLevBefAdj
real(DP):: QVapLowLevBefAdj
real(DP):: QVapUppLevBefAdj
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
integer:: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer:: itr ! イテレーション方向に回る DO ループ用作業変数
! Work variables for DO loop in iteration direction
real(DP):: xyz_RainCumulus (0:imax-1, 1:jmax, 1:kmax)
real(DP):: xy_NegDDelLWDt(0:imax-1, 1:jmax)
! 飽和比湿計算のための文関数定義
! Declaration of statement function for
! calculation of saturation specific humidity
!
#ifdef LIB_SATURATE_NHA1992
#include "../saturate/saturate_nha1992_sf.f90"
EpsVSF = EpsV
GasRUnivSF = GasRUniv
#elif LIB_SATURATE_T1930
#include "../saturate/saturate_t1930_sf.f90"
EpsVSF = EpsV
LatHeatSF = LatentHeat
GasRWetSF = GasRWet
#else
#include "../saturate/saturate_t1930_sf.f90"
EpsVSF = EpsV
LatHeatSF = LatentHeat
GasRWetSF = GasRWet
#endif
! 実行文 ; Executable statement
!
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
! 初期化
! Initialization
!
if ( .not. moist_conv_adjust_inited ) call MoistConvAdjustInit
if ( .not. FlagUse ) return
! 調節前 "QVap", "Temp" の保存
! Store "QVap", "Temp" before adjustment
!
xyz_QVapB = xyz_QVap
xyz_TempB = xyz_Temp
! 飽和比湿計算
! Calculate saturation specific humidity
!
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
! CalcQVapSatSF は文関数. (実行文の直前で定義)
! "CalcQVapSatSF" is statement function and
! is declared just before executable statement.
!
xyz_QVapSat(i,j,k) = CalcQVapSatSF( xyz_Temp(i,j,k), xyz_Press(i,j,k) )
end do
end do
end do
! Calculate some values used for moist convective adjustment
!
do k = 1, kmax
xyz_DelPress(:,:,k) = xyr_Press(:,:,k-1) - xyr_Press(:,:,k)
end do
! \frac{1}{2} \frac{ R }{Cp} \frac{ p_{k} - p_{k+1} }{ p_{k+1/2} }
!
! The value at k = 0 is not used.
k = 0
xyr_ConvAdjustFactor(:,:,k) = 0.0d0
!
do k = 1, kmax-1
xyr_ConvAdjustFactor(:,:,k) = GasRDry / CpDry * ( xyz_Press(:,:,k) - xyz_Press(:,:,k+1) ) / xyr_Press(:,:,k) / 2.0_DP
end do
! The value at k = kmax is not used.
k = kmax
xyr_ConvAdjustFactor(:,:,k) = 0.0d0
! 調節
! Adjustment
!
xy_AdjustB = .true.
! 繰り返し
! Iteration
!
do itr = 1, ItrtMax
xy_Adjust = .false.
do k = 1, kmax-1
do j = 1, jmax
do i = 0, imax-1
if ( xy_AdjustB(i,j) ) then
! Temperature equivalent to the excess moist static energy
! (Moist static energy difference devided by specific heat)
!
TempEquivToExcEne = xyz_Temp(i,j,k) - xyz_Temp(i,j,k+1) + LatentHeat / CpDry * ( xyz_QVapSat(i,j,k) - xyz_QVapSat(i,j,k+1) ) - xyr_ConvAdjustFactor(i,j,k) * ( xyz_Temp(i,j,k) + xyz_Temp(i,j,k+1) )
! Check vertical gradient of moist static energy
!
if ( TempEquivToExcEne > AdjustCriterion(itr) ) then
! Check relative humidity
!
if ( ( xyz_QVap(i,j,k+1) / xyz_QVapSat(i,j,k+1) >= CrtlRH ) .and. ( xyz_QVap(i,j,k ) / xyz_QVapSat(i,j,k ) >= CrtlRH ) ) then
DelQ = xyz_DelPress(i,j,k ) * ( xyz_QVap(i,j,k ) - xyz_QVapSat(i,j,k ) ) + xyz_DelPress(i,j,k+1) * ( xyz_QVap(i,j,k+1) - xyz_QVapSat(i,j,k+1) )
! CalcDQVapSatDTempSF は文関数. (実行文の直前で定義)
! "CalcDQVapSatDTempSF" is statement function and
! is declared just before executable statement.
!
DQVapSatDTempUppLev = CalcDQVapSatDTempSF( xyz_Temp(i,j,k+1), xyz_QVapSat(i,j,k+1) )
DQVapSatDTempLowLev = CalcDQVapSatDTempSF( xyz_Temp(i,j,k ), xyz_QVapSat(i,j,k ) )
GamUppLev = LatentHeat / CpDry * DQVapSatDTempUppLev
GamLowLev = LatentHeat / CpDry * DQVapSatDTempLowLev
DelTempUppLev = ( xyz_DelPress(i,j,k) * ( 1.0d0 + GamLowLev ) * TempEquivToExcEne + ( 1.0d0 + GamLowLev - xyr_ConvAdjustFactor(i,j,k) ) * LatentHeat / CpDry * DelQ ) / ( xyr_ConvAdjustFactor(i,j,k) * ( xyz_DelPress(i,j,k ) * ( 1.0d0 + GamLowLev ) - xyz_DelPress(i,j,k+1) * ( 1.0d0 + GamUppLev ) ) + ( 1.0d0 + GamLowLev ) * ( 1.0d0 + GamUppLev ) * ( xyz_DelPress(i,j,k) + xyz_DelPress(i,j,k+1) ) )
DelTempLowLev = ( LatentHeat / CpDry * DelQ - xyz_DelPress(i,j,k+1) * ( 1.0d0 + GamUppLev ) * DelTempUppLev ) / ( ( 1.0d0 + GamLowLev ) * xyz_DelPress(i,j,k) )
!=========
! check routine
!---------
!!$ TempLowLevBefAdj = xyz_Temp(i,j,k )
!!$ TempUppLevBefAdj = xyz_Temp(i,j,k+1)
!!$ QVapLowLevBefAdj = xyz_QVap(i,j,k )
!!$ QVapUppLevBefAdj = xyz_QVap(i,j,k+1)
!=========
! 温度の調節
! Adjust temperature
!
xyz_Temp(i,j,k ) = xyz_Temp(i,j,k ) + DelTempLowLev
xyz_Temp(i,j,k+1) = xyz_Temp(i,j,k+1) + DelTempUppLev
! 比湿の調節
! Adjust specific humidity
!
xyz_QVap(i,j,k ) = xyz_QVapSat(i,j,k ) + DQVapSatDTempLowLev * DelTempLowLev
xyz_QVap(i,j,k+1) = xyz_QVapSat(i,j,k+1) + DQVapSatDTempUppLev * DelTempUppLev
!=========
! check routine
!---------
!!$ write( 6, * ) '====='
!!$ write( 6, * ) xyz_Temp(i,j,k), xyz_Temp(i,j,k+1), xyz_QVap(i,j,k), xyz_QVap(i,j,k+1)
!!$ write( 6, * ) DelTempLowLev, DelTempUppLev
!!$ write( 6, * ) 'Energy difference before and after adjustment and each energy'
!!$ write( 6, * ) &
!!$ & ( CpDry * TempLowLevBefAdj + LatentHeat * QVapLowLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k ) / Grav &
!!$ & + ( CpDry * TempUppLevBefAdj + LatentHeat * QVapUppLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k+1) / Grav &
!!$ & - ( CpDry * xyz_Temp(i,j,k ) + LatentHeat * xyz_QVap(i,j,k ) ) &
!!$ & * xyz_DelPress(i,j,k ) / Grav &
!!$ & - ( CpDry * xyz_Temp(i,j,k+1) + LatentHeat * xyz_QVap(i,j,k+1) ) &
!!$ & * xyz_DelPress(i,j,k+1) / Grav, &
!!$ & ( CpDry * TempLowLevBefAdj + LatentHeat * QVapLowLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k ) / Grav, &
!!$ & ( CpDry * TempUppLevBefAdj + LatentHeat * QVapUppLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k+1) / Grav, &
!!$ & ( CpDry * xyz_Temp(i,j,k ) + LatentHeat * xyz_QVap(i,j,k ) ) &
!!$ & * xyz_DelPress(i,j,k ) / Grav, &
!!$ & ( CpDry * xyz_Temp(i,j,k+1) + LatentHeat * xyz_QVap(i,j,k+1) ) &
!!$ & * xyz_DelPress(i,j,k+1) / Grav
!!$ write( 6, * ) 'Difference of moist static energy after adjustment'
!!$ write( 6, * ) &
!!$ & ( CpDry * xyz_Temp(i,j,k ) + LatentHeat * xyz_QVap(i,j,k ) ) &
!!$ & - ( CpDry * xyz_Temp(i,j,k+1) + LatentHeat * xyz_QVap(i,j,k+1) ) &
!!$ & - CpDry * xyr_ConvAdjustFactor(i,j,k) &
!!$ & * ( xyz_Temp(i,j,k) + xyz_Temp(i,j,k+1) ), &
!!$ & ( CpDry * xyz_Temp(i,j,k ) + LatentHeat * xyz_QVap(i,j,k ) ), &
!!$ & ( CpDry * xyz_Temp(i,j,k+1) + LatentHeat * xyz_QVap(i,j,k+1) ), &
!!$ & - CpDry * xyr_ConvAdjustFactor(i,j,k) &
!!$ & * ( xyz_Temp(i,j,k) + xyz_Temp(i,j,k+1) )
!!$ write( 6, * ) 'Difference of water vapor amount before and after adjustment'
!!$ write( 6, * ) &
!!$ & - LatentHeat * ( xyz_QVap(i,j,k ) - QVapLowLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k ) / Grav, &
!!$ & - LatentHeat * ( xyz_QVap(i,j,k+1) - QVapUppLevBefAdj ) &
!!$ & * xyz_DelPress(i,j,k+1) / Grav
!=========
xyz_QVapSat(i,j,k ) = xyz_QVap(i,j,k )
xyz_QVapSat(i,j,k+1) = xyz_QVap(i,j,k+1)
! 調節したか否か?
! Whether it was adjusted or not?
!
xy_Adjust(i,j) = .true.
end if
end if
end if
end do
end do
end do
Adjust = .false.
do i = 0, imax-1
do j = 1, jmax
xy_AdjustB(i,j) = xy_Adjust(i,j)
Adjust = Adjust .or. xy_Adjust(i,j)
end do
end do
if ( .not. Adjust ) exit
end do
! 比湿変化率, 温度変化率, 降水量の算出
! Calculate specific humidity tendency, temperature tendency, precipitation
!
xyz_DQVapDtCumulus = ( xyz_QVap - xyz_QVapB ) / ( 2.0_DP * DelTime )
xyz_DTempDtCumulus = ( xyz_Temp - xyz_TempB ) / ( 2.0_DP * DelTime )
! OLD CODE TO BE DELETED
!
!!$ xy_RainCumulus = 0.
!!$ do k = 1, kmax
!!$ xy_RainCumulus = xy_RainCumulus &
!!$ & + ( xyz_QVapB(:,:,k) - xyz_QVap(:,:,k) ) &
!!$ & * xyz_DelPress(:,:,k) / Grav / ( 2.0_DP * DelTime )
!!$ end do
!!$ i = imax/2
!!$ j = jmax/2+1
!!$ write( 6, * ) xy_RainCumulus(i,j)
xy_RainCumulus = 0.0d0
do k = kmax, 1, -1
xy_RainCumulus = xy_RainCumulus + xyz_DelPress(:,:,k) / Grav * ( xyz_QVapB(:,:,k) - xyz_QVap(:,:,k) )
end do
xy_RainCumulus = xy_RainCumulus / ( 2.0_DP * DelTime )
!!$ i = imax/2
!!$ j = jmax/2+1
!!$ write( 6, * ) xy_RainCumulus(i,j)
!!$ write( 6, * ) '---'
xy_Rain = xy_Rain + xy_RainCumulus
xyz_DTempDt = xyz_DTempDt + xyz_DTempDtCumulus
xyz_DQVapDt = xyz_DQVapDt + xyz_DQVapDtCumulus
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'RainCumulus', xy_RainCumulus * LatentHeat )
call HistoryAutoPut( TimeN, 'DTempDtCumulus', xyz_DTempDtCumulus )
call HistoryAutoPut( TimeN, 'DQVapDtCumulus', xyz_DQVapDtCumulus )
if ( present( xyz_DDelLWDtCCP ) ) then
xyz_DDelLWDtCCP = + ( xyz_QVapB - xyz_QVap ) * xyz_DelPress / Grav / ( 2.0d0 * DelTime )
!=========
! check routine
!---------
!!$ write( 6, * ) '====='
!!$ i = 0
!!$ j = jmax/2+1
!!$ i = 23
!!$ j = 21
!!$ do k = kmax, 1, -1
!!$ write( 6, * ) k, xyz_DDelLWDtCCP(i,j,k)
!!$ end do
!=========
! Negative cloud production rate is filled with values in lower layers.
!
xy_NegDDelLWDt = 0.0d0
do k = kmax, 1, -1
do j = 1, jmax
do i = 0, imax-1
xyz_DDelLWDtCCP(i,j,k) = xyz_DDelLWDtCCP(i,j,k) + xy_NegDDelLWDt(i,j)
if ( xyz_DDelLWDtCCP(i,j,k) < 0.0d0 ) then
!!$ if ( k == 1 ) then
!!$ call MessageNotify( 'E', module_name, 'Unexpected negative value at (%d,%d,%d)', i = (/ i, j, k /) )
!!$ end if
xy_NegDDelLWDt(i,j) = xyz_DDelLWDtCCP(i,j,k)
xyz_DDelLWDtCCP(i,j,k) = 0.0d0
end if
end do
end do
end do
!=========
! check routine
!---------
!!$ write( 6, * ) '-----'
!!$ i = 0
!!$ j = jmax/2+1
!!$ i = 23
!!$ j = 21
!!$ do k = kmax, 1, -1
!!$ write( 6, * ) k, xyz_DDelLWDtCCP(i,j,k)
!!$ end do
!!$ write( 6, * ) '====='
!=========
end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine MoistConvAdjust