| Class | relaxed_arakawa_schubert |
| In: |
cumulus/relaxed_arakawa_schubert.f90
|
Note that Japanese and English are described in parallel.
Change temperature and specific humidity by using the Relaxed Arakawa-Schubert scheme
Lord, S. J., W. C. Chao, and A. Arakawa, Interaction of a cumulus cloud ensemble with the large-scale environment. Part IV: The discrete model, J. Atmos. Sci., 39, 104-113, 1992. Moorthi, S., and M. J. Suarez, Relaxed Arakawa-Schubert: A parameterization of moist convection for general circulation models, Mon. Wea. Rev., 120, 978-1002, 1992.
| RelaxedArakawaSchubert : | 温度と比湿の調節 |
| ———————- : | ———— |
| RelaxedArakawaSchubert : | Change temperature and specific humidity |
| Subroutine : | |||||
| xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in )
| ||||
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_Exner(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Exner(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
| ||||
| xyz_QH2OVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
| ||||
| xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_MoistConvDetTend(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional | ||||
| xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RAS( xy_SurfTemp, xyz_Press, xyr_Press, xyz_Exner, xyr_Exner, xyz_Temp, xyz_QH2OVap, xyz_DQH2OLiqDt, xyz_MoistConvDetTend, xyz_MoistConvSubsidMassFlux )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat
! $ L $ [J kg-1] .
! 凝結の潜熱.
! Latent heat of condensation
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: xyz_CalcQVapSat, xyz_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ArakawaSchubertL1982CalcCWFCrtl
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: xy_SurfTemp (0:imax-1, 1:jmax)
! Pressure
real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! Pressure
real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! Pressure
real(DP), intent(in ) :: xyz_Exner (0:imax-1, 1:jmax, 1:kmax)
! Exner function
real(DP), intent(in ) :: xyr_Exner (0:imax-1, 1:jmax, 0:kmax)
! Exner function
real(DP), intent(inout) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP), intent(inout) :: xyz_QH2OVap (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(out ) :: xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvDetTend (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: xyz_Height (0:imax-1, 1:jmax, 1:kmax)
!
! Height
real(DP) :: xyr_Height (0:imax-1, 1:jmax, 0:kmax)
!
! Height
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_DelPress(0:imax-1, 1:jmax, 1:kmax)
! $ \Delta p $
!
real(DP) :: xyz_PotTemp (0:imax-1, 1:jmax, 1:kmax)
! Potential temperature
!
real(DP) :: xyz_QH2OVapSat (0:imax-1, 1:jmax, 1:kmax)
! 飽和比湿.
! Saturation specific humidity.
! Dry and moist static energy in environment (Env) and cloud (Cld)
!
real(DP) :: xyz_EnvDryStaticEne (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyr_EnvDryStaticEne (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyz_EnvMoistStaticEne (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyr_EnvMoistStaticEne (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyz_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyr_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyr_CldMoistStaticEne (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xy_Kernel (0:imax-1, 1:jmax)
! Tendency of cloud work function by cumulus convection, kernel
real(DP) :: xy_CWF (0:imax-1, 1:jmax)
! Cloud work function
real(DP) :: xyz_CWF (0:imax-1, 1:jmax, 1:kmax)
! Cloud work function
! (variable for output)
real(DP) :: xy_DCWFDtLS (0:imax-1, 1:jmax)
! Tendency of cloud work function by large scale motion
real(DP) :: xyz_DCWFDtLS (0:imax-1, 1:jmax, 1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
real(DP) :: xy_CldMassFluxBottom (0:imax-1, 1:jmax)
! Cloud mass flux at cloud bottom
real(DP) :: xyz_Beta (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_BetaCldTop (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_Gamma (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_GammaDSE (0:imax-1, 1:jmax, 1:kmax)
! Tendency of dry static energy per unit mass flux
real(DP) :: xyz_GammaMSE (0:imax-1, 1:jmax, 1:kmax)
! Tendency of moist static energy per unit mass flux
real(DP) :: xyz_Mu (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_Eps (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xy_PressCldBase (0:imax-1, 1:jmax)
! Pressure of cloud base
real(DP) :: xyz_CWFCrtl (0:imax-1, 1:jmax, 1:kmax)
! "Critical value" of cloud work function
real(DP) :: xyz_DetCldWatCondFactor (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xy_EntParam (0:imax-1, 1:jmax)
! Entrainment factor
real(DP) :: xyz_EntParam (0:imax-1, 1:jmax, 1:kmax)
! Entrainment factor (variable for output)
real(DP) :: xy_EntParamLL (0:imax-1, 1:jmax)
! Entrainment factor for a cloud with top at one layer
! higher level
real(DP) :: xy_EntParamUL (0:imax-1, 1:jmax)
! Entrainment factor for a cloud with top at one layer
! lower level
! Difference of normalized mass flux between layer interface
real(DP) :: xyz_DelNormMassFlux (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xy_DelNormMassFluxCldTop(0:imax-1, 1:jmax)
! Normalized mass flux at layer interface and cloud top
real(DP) :: xyr_NormMassFlux (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xy_NormMassFluxCldTop (0:imax-1, 1:jmax)
! Liquid water at cloud top
real(DP) :: xy_CldQH2OLiqCldTop (0:imax-1, 1:jmax)
! Mass flux distribution function
real(DP) :: xyz_MassFluxDistFunc (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_DelH2OMass (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xy_H2OMassB (0:imax-1, 1:jmax)
real(DP) :: xy_H2OMassA (0:imax-1, 1:jmax)
real(DP) :: xyz_RainCumulus (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_NegDDelLWDt (0:imax-1, 1:jmax)
!!$ real(DP) :: xyz_DDelLWDtCCPLV(0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ logical :: xy_FlagCrossSatEquivPotTemp(0:imax-1, 1:jmax)
!!$ !
!!$ ! Flag showing whether a parcel in cloud has moist static
!!$ ! energy larger than environment's
real(DP) :: xyr_QH2OVapSat (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyr_TempAdiabAscent (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xy_SurfPotTemp (0:imax-1, 1:jmax)
!!$ real(DP) :: xyz_TempAdiabAscent (0:imax-1, 1:jmax, 1:kmax)
! Variables for looking for top of mixed layer
!
logical :: xy_FlagMixLayTopFound (0:imax-1, 1:jmax)
integer :: xy_IndexMixLayTop (0:imax-1, 1:jmax)
! Variables for modification of cloud mass flux
!
real(DP) :: xyz_QH2OVapTentative (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: CldMassFluxCorFactor
real(DP) :: xy_CldMassFluxCorFactor(0:imax-1, 1:jmax)
real(DP) :: xyz_TempB (0:imax-1, 1:jmax, 1:kmax)
! 調節前の温度.
! Temperature before adjustment
real(DP) :: xyz_QH2OVapB(0:imax-1, 1:jmax, 1:kmax)
! 調節前の比湿.
! Specific humidity before adjustment
real(DP) :: xyz_QH2OLiqB(0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_QH2OLiq (0:imax-1, 1:jmax, 1:kmax)
! Flags for modification of
!
logical :: xy_FlagKernelNegative (0:imax-1, 1:jmax)
logical :: xy_FlagNegH2OLiqCldTop(0:imax-1, 1:jmax)
! Variables for subsidence mass flux between updrafts
!
real(DP) :: DelNormMassFluxHalfLayer
real(DP) :: NormMassFlux
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
real(DP) :: xy_SumTmp(0:imax-1, 1:jmax)
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 :: l
integer :: m
integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
! 調節前 "Temp", "QH2OVap" の保存
! Store "Temp", "QH2OVap" before adjustment
!
xyz_TempB = xyz_Temp
xyz_QH2OVapB = xyz_QH2OVap
! Preparation of variables
!
!
! Auxiliary variables
! Pressure difference between upper and lower interface of the layer
do k = 1, kmax
xyz_DelPress(:,:,k) = xyr_Press(:,:,k-1) - xyr_Press(:,:,k)
end do
! beta
do k = 1, kmax
xyz_Beta(:,:,k) = CpDry / Grav * ( xyr_Exner(:,:,k-1) - xyr_Exner(:,:,k) )
end do
do k = 1, kmax
xyz_BetaCldTop(:,:,k) = CpDry / Grav * ( xyr_Exner(:,:,k-1) - xyz_Exner(:,:,k) )
end do
!
! Search for top of mixed layer (lifting condensation level) based on
! a description in p.684 of Arakawa and Shubert (1974).
!
call RASHeight( xyz_Temp, xyz_Exner, xyz_Beta, xyz_BetaCldTop, xyz_Height, xyr_Height )
!
!====================================
!
!!$ xyz_TempAdiabAscent(:,:,1) = xyz_Temp(:,:,1)
!!$ do k = 2, kmax
!!$ xyz_TempAdiabAscent(:,:,k) = &
!!$ & xyz_Temp(:,:,1) - Grav / CpDry * ( xyz_Height(:,:,k) - xyz_Height(:,:,1) )
!!$ end do
!!$ xyz_TempAdiabAscent = max( xyz_TempAdiabAscent, 1.0_DP )
!!$ xyz_QH2OVapSat = xyz_CalcQVapSat( xyz_TempAdiabAscent, xyz_Press )
!!$ xy_IndexMixLayTop = 1
!!$ xy_FlagMixLayTopFound = .false.
!!$ do k = 2, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xyz_QH2OVap(i,j,1) >= xyz_QH2OVapSat(i,j,k) ) .and. &
!!$ & ( .not. xy_FlagMixLayTopFound(i,j) ) ) then
!!$ xy_IndexMixLayTop (i,j) = k - 1
!!$ xy_FlagMixLayTopFound(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!
!------------------------------------
!
!!$ xyr_TempAdiabAscent(:,:,0) = xy_SurfTemp
!!$ do k = 1, kmax
!!$ xyr_TempAdiabAscent(:,:,k) = &
!!$ & xy_SurfTemp - Grav / CpDry * ( xyr_Height(:,:,k) - 0.0_DP )
!!$ end do
!!$ xyr_TempAdiabAscent = max( xyr_TempAdiabAscent, 1.0_DP )
!!$
xyr_TempAdiabAscent(:,:,0) = xy_SurfTemp
xy_SurfPotTemp = xy_SurfTemp / xyr_Exner(:,:,0)
do k = 1, kmax
xyr_TempAdiabAscent(:,:,k) = xy_SurfPotTemp * xyr_Exner(:,:,k)
end do
!
xyr_QH2OVapSat(:,:,0 ) = 1.0d100
xyr_QH2OVapSat(:,:,1:kmax-1) = xyz_CalcQVapSat( xyr_TempAdiabAscent(:,:,1:kmax-1), xyr_Press(:,:,1:kmax-1) )
xyr_QH2OVapSat(:,:,kmax ) = xyr_QH2OVapSat(:,:,kmax-1)
!
xy_IndexMixLayTop = 1
xy_FlagMixLayTopFound = .false.
do k = 2, kmax
do j = 1, jmax
do i = 0, imax-1
if ( ( xyz_QH2OVap(i,j,1) >= xyr_QH2OVapSat(i,j,k) ) .and. ( .not. xy_FlagMixLayTopFound(i,j) ) ) then
xy_IndexMixLayTop (i,j) = k - 1
xy_FlagMixLayTopFound(i,j) = .true.
end if
end do
end do
end do
!
!====================================
!
do j = 1, jmax
do i = 0, imax-1
if ( .not. xy_FlagMixLayTopFound(i,j) ) then
xy_IndexMixLayTop(i,j) = kmax - 1
end if
end do
end do
!
! Critical cloud work function
!
if ( FlagZeroCrtlCWF ) then
xyz_CWFCrtl = 0.0_DP
else
do j = 1, jmax
do i = 0, imax-1
xy_PressCldBase(i,j) = xyr_Press(i,j,xy_IndexMixLayTop(i,j))
end do
end do
call ArakawaSchubertL1982CalcCWFCrtl( xy_PressCldBase, xyz_Press, xyz_CWFCrtl )
end if
!
! Rain conversion factor
!
if ( DetCldWatCondFactor0 < 0.0_DP ) then
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
if ( xyz_Press(i,j,k) < 500.0d2 ) then
xyz_DetCldWatCondFactor(i,j,k) = 1.0_DP
else if ( xyz_Press(i,j,k) < 800.0d2 ) then
xyz_DetCldWatCondFactor(i,j,k) = 0.8_DP + ( 800.0d2 - xyz_Press(i,j,k) ) / 1500.0d2
else
xyz_DetCldWatCondFactor(i,j,k) = 0.8_DP
end if
end do
end do
end do
else
xyz_DetCldWatCondFactor = DetCldWatCondFactor0
end if
xyz_RainCumulus (:,:,1) = 0.0_DP
xyz_EntParam (:,:,1) = 0.0_DP
xyz_CWF (:,:,1) = 0.0_DP
xyz_DCWFDtLS (:,:,1) = 0.0_DP
xyz_MassFluxDistFunc(:,:,1) = 0.0_DP
if ( present( xyz_MoistConvDetTend ) ) then
xyz_MoistConvDetTend(:,:,1) = 0.0_DP
end if
if ( present( xyz_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
! Initialization
!
xyz_MoistConvSubsidMassFlux = 0.0_DP
end if
loop_cloud_top : do l = 2, kmax
call RASHeight( xyz_Temp, xyz_Exner, xyz_Beta, xyz_BetaCldTop, xyz_Height, xyr_Height )
! Potential temperature
!
xyz_PotTemp = xyz_Temp / xyz_Exner
! Saturation mixing ratio
!
xyz_QH2OVapSat = xyz_CalcQVapSat( xyz_Temp, xyz_Press )
! Calculation of dry and moist static energies
!
xyz_EnvDryStaticEne = CpDry * xyz_Temp + Grav * xyz_Height
xyz_EnvMoistStaticEne = xyz_EnvDryStaticEne + LatentHeat * xyz_QH2OVap
!
k = 0
xyr_EnvDryStaticEne (:,:,k) = 1.0d100
xyr_EnvMoistStaticEne(:,:,k) = 1.0d100
do k = 1, kmax-1
xyr_EnvDryStaticEne (:,:,k) = ( xyz_EnvDryStaticEne (:,:,k) + xyz_EnvDryStaticEne (:,:,k+1) ) / 2.0_DP
xyr_EnvMoistStaticEne(:,:,k) = ( xyz_EnvMoistStaticEne(:,:,k) + xyz_EnvMoistStaticEne(:,:,k+1) ) / 2.0_DP
end do
k = kmax
xyr_EnvDryStaticEne (:,:,k) = xyz_EnvDryStaticEne (:,:,k)
xyr_EnvMoistStaticEne(:,:,k) = xyz_EnvMoistStaticEne(:,:,k)
! Calculation of saturated moist static energy
!
xyz_EnvMoistStaticEneSat = xyz_EnvDryStaticEne + LatentHeat * xyz_QH2OVapSat
!
k = 0
xyr_EnvMoistStaticEneSat(:,:,k) = 1.0d100
do k = 1, kmax-1
xyr_EnvMoistStaticEneSat(:,:,k) = ( xyz_EnvMoistStaticEneSat(:,:,k) + xyz_EnvMoistStaticEneSat(:,:,k+1) ) / 2.0_DP
end do
k = kmax
xyr_EnvMoistStaticEneSat(:,:,k) = xyz_EnvMoistStaticEneSat(:,:,k)
! Auxiliary variables
!
xyz_Gamma = LatentHeat / CpDry * xyz_CalcDQVapSatDTemp( xyz_Temp, xyz_QH2OVapSat )
!
k = 1
xyz_Mu (:,:,k) = 1.0d100
xyz_Eps(:,:,k) = 1.0d100
do k = 2, kmax
xyz_Mu (:,:,k) = ( xyz_Exner(:,:,k ) - xyr_Exner(:,:,k) ) / ( xyz_Exner(:,:,k) * ( 1.0_DP + xyz_Gamma(:,:,k) ) )
xyz_Eps(:,:,k) = ( xyr_Exner(:,:,k-1) - xyz_Exner(:,:,k) ) / ( xyz_Exner(:,:,k) * ( 1.0_DP + xyz_Gamma(:,:,k) ) )
end do
! Entrainment parameter
!
call RASEntParam( l, xyz_Beta, xyz_BetaCldTop, xyz_PotTemp, xyz_EnvMoistStaticEne, xyz_EnvMoistStaticEneSat, xy_IndexMixLayTop, xy_EntParam )
if ( l >= 3 ) then
call RASEntParam( l-1, xyz_Beta, xyz_BetaCldTop, xyz_PotTemp, xyz_EnvMoistStaticEne, xyz_EnvMoistStaticEneSat, xy_IndexMixLayTop, xy_EntParamLL )
else
xy_EntParamLL = 1.0d100
end if
if ( l <= kmax-1 ) then
call RASEntParam( l+1, xyz_Beta, xyz_BetaCldTop, xyz_PotTemp, xyz_EnvMoistStaticEne, xyz_EnvMoistStaticEneSat, xy_IndexMixLayTop, xy_EntParamUL )
else
xy_EntParamUL = 1.0d100
end if
! for output
xyz_EntParam(:,:,l) = xy_EntParam
! Difference of normalized mass flux
!
! difference of normalized mass flux between layer bottom and top
!
xyz_DelNormMassFlux(:,:,1) = 1.0d100
do k = 2, l-1
xyz_DelNormMassFlux(:,:,k) = - xy_EntParam * xyz_Beta(:,:,k) * xyz_PotTemp(:,:,k)
end do
do k = l, kmax
xyz_DelNormMassFlux(:,:,k) = 1.0d100
end do
!
! difference of normalized mass flux between layer bottom and mid-point
!
xy_DelNormMassFluxCldTop = - xy_EntParam * xyz_BetaCldTop(:,:,l) * xyz_PotTemp(:,:,l)
! Normalized mass flux
!
! normalized mass flux at layer interface
!
xyr_NormMassFlux(:,:,0) = 0.0_DP
do k = 1, l-1
do j = 1, jmax
do i = 0, imax-1
if ( k < xy_IndexMixLayTop(i,j) ) then
xyr_NormMassFlux(i,j,k) = 0.0_DP
else if ( k == xy_IndexMixLayTop(i,j) ) then
xyr_NormMassFlux(i,j,k) = 1.0_DP
else
xyr_NormMassFlux(i,j,k) = xyr_NormMassFlux(i,j,k-1) - xyz_DelNormMassFlux(i,j,k)
end if
end do
end do
end do
do k = l, kmax
xyr_NormMassFlux(:,:,k) = 0.0_DP
end do
!
! normalized mass flux at cloud top (at layer mid-point)
!
xy_NormMassFluxCldTop = xyr_NormMassFlux(:,:,l-1) - xy_DelNormMassFluxCldTop
! Liquid water content at top of clouds
! If l is less than xy_IndexMixLayTop(i,j), i.e. the cloud top is below top of
! mixed layer, xy_SumTmp is zero, then, xy_CldQH2OLiqCldTop is also zero.
!
do j = 1, jmax
do i = 0, imax-1
if ( l > xy_IndexMixLayTop(i,j) ) then
xy_SumTmp(i,j) = xyz_QH2OVap(i,j,xy_IndexMixLayTop(i,j))
do k = xy_IndexMixLayTop(i,j)+1, l-1
xy_SumTmp(i,j) = xy_SumTmp(i,j) - xyz_DelNormMassFlux(i,j,k) * xyz_QH2OVap(i,j,k)
end do
xy_SumTmp(i,j) = xy_SumTmp(i,j) - xy_DelNormMassFluxCldTop(i,j) * xyz_QH2OVap(i,j,l)
else
xy_SumTmp(i,j) = 0.0_DP
end if
end do
end do
xy_CldQH2OLiqCldTop = xy_SumTmp / ( xy_NormMassFluxCldTop + 1.0d-100 ) - xyz_QH2OVapSat(:,:,l)
! Check whether kernel is positive or negative.
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_CldQH2OLiqCldTop(i,j) < 0.0_DP ) then
xy_FlagNegH2OLiqCldTop(i,j) = .true.
else
xy_FlagNegH2OLiqCldTop(i,j) = .false.
end if
end do
end do
! avoid negative value
xy_CldQH2OLiqCldTop = max( xy_CldQH2OLiqCldTop, 0.0_DP )
! Moist static energy in clouds
!
xyr_CldMoistStaticEne(:,:,0) = 1.0d100
do k = 1, l-1
do j = 1, jmax
do i = 0, imax-1
if ( k < xy_IndexMixLayTop(i,j) ) then
xyr_CldMoistStaticEne(i,j,k) = 1.0d100
else if ( k == xy_IndexMixLayTop(i,j) ) then
xyr_CldMoistStaticEne(i,j,k) = xyz_EnvMoistStaticEne(i,j,xy_IndexMixLayTop(i,j))
else
xyr_CldMoistStaticEne(i,j,k) = ( xyr_NormMassFlux(i,j,k-1) * xyr_CldMoistStaticEne(i,j,k-1) - xyz_DelNormMassFlux(i,j,k) * xyz_EnvMoistStaticEne(i,j,k) ) / xyr_NormMassFlux(i,j,k)
end if
end do
end do
end do
do k = l, kmax
xyr_CldMoistStaticEne(:,:,k) = 1.0d100
end do
!###############################################
! Check whether a parcel in cloud has moist static energy larger than environment's
!
!!$ xy_FlagCrossSatEquivPotTemp = .false.
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ do k = xy_IndexMixLayTop(i,j), l-1
!!$ if ( xyr_EnvMoistStaticEneSat(i,j,k) < xyr_CldMoistStaticEne(i,j,k) ) then
!!$ xy_FlagCrossSatEquivPotTemp(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!###############################################
! Cloud work function
!
xy_CWF = 0.0_DP
do k = 2, l-1
do j = 1, jmax
do i = 0, imax-1
if ( k > xy_IndexMixLayTop(i,j) ) then
xy_CWF(i,j) = xy_CWF(i,j) + xyz_Mu (i,j,k) * xyr_NormMassFlux(i,j,k ) * ( xyr_CldMoistStaticEne(i,j,k ) - xyz_EnvMoistStaticEneSat(i,j,k) ) + xyz_Eps(i,j,k) * xyr_NormMassFlux(i,j,k-1) * ( xyr_CldMoistStaticEne(i,j,k-1) - xyz_EnvMoistStaticEneSat(i,j,k) )
end if
end do
end do
end do
k = l
do j = 1, jmax
do i = 0, imax-1
if ( k > xy_IndexMixLayTop(i,j) ) then
xy_CWF(i,j) = xy_CWF(i,j) + xyz_Eps(i,j,k) * xyr_NormMassFlux(i,j,k-1) * ( xyr_CldMoistStaticEne(i,j,k-1) - xyz_EnvMoistStaticEneSat(i,j,k) )
end if
end do
end do
! for save
xyz_CWF(:,:,l) = xy_CWF
! Time derivative of cloud work function by large scale motion
!
xy_DCWFDtLS = ( xy_CWF - xyz_CWFCrtl(:,:,l) ) / ( 2.0_DP * DelTime )
! for save
xyz_DCWFDtLS(:,:,l) = xy_DCWFDtLS
! Tendency of dry static energy per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
xyz_GammaDSE(:,:,k) = - Grav / xyz_DelPress(:,:,k) * xyr_NormMassFlux(:,:,k ) * ( xyz_EnvDryStaticEne(:,:,k ) - xyz_EnvDryStaticEne(:,:,k+1) )
else
xyz_GammaDSE(:,:,k) = 0.0_DP
end if
end do
else
do k = 1, l
xyz_GammaDSE(:,:,k) = - Grav / xyz_DelPress(:,:,k) * ( xyr_NormMassFlux(:,:,k-1) * ( xyr_EnvDryStaticEne(:,:,k-1) - xyz_EnvDryStaticEne(:,:,k) ) + xyr_NormMassFlux(:,:,k ) * ( xyz_EnvDryStaticEne(:,:,k ) - xyr_EnvDryStaticEne(:,:,k) ) )
end do
end if
k = l
xyz_GammaDSE(:,:,k) = xyz_GammaDSE(:,:,k) - Grav / xyz_DelPress(:,:,k) * LatentHeat * xy_CldQH2OLiqCldTop * xy_NormMassFluxCldTop * ( 1.0_DP - xyz_DetCldWatCondFactor(:,:,k) )
do k = l+1, kmax
xyz_GammaDSE(:,:,k) = 0.0_DP
end do
! Tendency of moist static energy per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
xyz_GammaMSE(:,:,k) = - Grav / xyz_DelPress(:,:,k) * xyr_NormMassFlux(:,:,k ) * ( xyz_EnvMoistStaticEne(:,:,k ) - xyz_EnvMoistStaticEne(:,:,k+1) )
else
xyz_GammaMSE(:,:,k) = 0.0_DP
end if
end do
else
do k = 1, l
xyz_GammaMSE(:,:,k) = - Grav / xyz_DelPress(:,:,k) * ( xyr_NormMassFlux(:,:,k-1) * ( xyr_EnvMoistStaticEne(:,:,k-1) - xyz_EnvMoistStaticEne(:,:,k) ) + xyr_NormMassFlux(:,:,k ) * ( xyz_EnvMoistStaticEne(:,:,k ) - xyr_EnvMoistStaticEne(:,:,k) ) )
end do
end if
k = l
xyz_GammaMSE(:,:,k) = xyz_GammaMSE(:,:,k) + Grav / xyz_DelPress(:,:,k) * xy_NormMassFluxCldTop * ( xyz_EnvMoistStaticEneSat(:,:,k) - xyz_EnvMoistStaticEne(:,:,k) )
do k = l+1, kmax
xyz_GammaMSE(:,:,k) = 0.0_DP
end do
! Kernel, time derivative of cloud work function by cumulus convection per unit
! mass flux
!
do j = 1, jmax
do i = 0, imax-1
xy_Kernel(i,j) = xyz_Eps(i,j,xy_IndexMixLayTop(i,j)+1) * xyz_GammaMSE(i,j,xy_IndexMixLayTop(i,j)) - xyz_Eps(i,j,l) * xyr_NormMassFlux(i,j,l-1) * ( 1.0_DP + xyz_Gamma(i,j,l) ) * xyz_GammaDSE(i,j,l)
do n = xy_IndexMixLayTop(i,j)+1, l-1
xy_SumTmp(i,j) = 0.0_DP
do m = xy_IndexMixLayTop(i,j)+1, n
xy_SumTmp(i,j) = xy_SumTmp(i,j) + xyz_DelNormMassFlux(i,j,m) * xyz_GammaMSE(i,j,m)
end do
xy_Kernel(i,j) = xy_Kernel(i,j) + ( xyz_Eps(i,j,n+1) + xyz_Mu(i,j,n) ) * ( xyz_GammaMSE(i,j,xy_IndexMixLayTop(i,j)) - xy_SumTmp(i,j) ) - ( xyz_Eps(i,j,n) * xyr_NormMassFlux(i,j,n-1) + xyz_Mu (i,j,n) * xyr_NormMassFlux(i,j,n ) ) * ( 1.0_DP + xyz_Gamma(i,j,n) ) * xyz_GammaDSE(i,j,n)
end do
end do
end do
! Check whether kernel is positive or negative.
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_Kernel(i,j) < 0.0_DP ) then
xy_FlagKernelNegative(i,j) = .true.
else
xy_FlagKernelNegative(i,j) = .false.
end if
end do
end do
! Load et al. (1982), p.108
xy_Kernel = min( xy_Kernel, -5.0d-3 )
! Cloud mass flux at cloud bottom
!
xy_CldMassFluxBottom = - xy_DCWFDtLS / xy_Kernel
!
! mass flux has to be zero or positive
xy_CldMassFluxBottom = max( xy_CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
do j = 1, jmax
do i = 0, imax-1
if ( xy_EntParam(i,j) <= 0.0_DP ) then
xy_CldMassFluxBottom(i,j) = 0.0_DP
end if
end do
end do
!!$ ! mass flux is zero if it is below lifting condensation level
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( .not. xy_FlagCrossSatEquivPotTemp(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end do
!!$ end do
! mass flux is zero if the LNB is unstable for updrafts
! (i.e., if the parcel is positively buoyant just above the LNB).
! See Lord et al. (1982), p.112, for more details.
! Strictly speaking, the process below is different from that
! proposed by Lord et al. (1982). Lord et al. (1982) compare
! entrainment parameters at 3 levels. But, entrainment
! parameters at 2 levels are compared below, because comparison
! of values between 2 levels seems to be sufficient.
!!$ if ( ( 3 <= l ) .and. ( l <= kmax-1 ) ) then
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end if
!!$ end do
!!$ end do
!!$ end if
do j = 1, jmax
do i = 0, imax-1
!!$ if ( xy_IndexMixLayTop(i,j) == l ) then
!!$ if ( ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ if ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end if
!!$ else if ( ( xy_IndexMixLayTop(i,j) < l ) .and. ( l <= kmax-1 ) ) then
!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
if ( ( xy_IndexMixLayTop(i,j) <= l ) .and. ( l <= kmax-1 ) ) then
if ( ( xy_EntParam (i,j) > 0.0_DP ) .and. ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
if ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) then
xy_CldMassFluxBottom(i,j) = 0.0_DP
end if
end if
end if
end do
end do
!
! mass flux is zero unless kernel is negative
!
do j = 1, jmax
do i = 0, imax-1
if ( .not. xy_FlagKernelNegative(i,j) ) then
xy_CldMassFluxBottom(i,j) = 0.0_DP
end if
end do
end do
!
! mass flux is zero if liquid water at a cloud top is negative
!
do j = 1, jmax
do i = 0, imax-1
if ( xy_FlagNegH2OLiqCldTop(i,j) ) then
xy_CldMassFluxBottom(i,j) = 0.0_DP
end if
end do
end do
!
! multiply factor
!
xy_CldMassFluxBottom = xy_CldMassFluxBottom * min( 2.0_DP * DelTime / AdjTimeConst, 1.0_DP )
!
! for output
xyz_MassFluxDistFunc(:,:,l) = xy_CldMassFluxBottom
! Check values of cloud mass flux
! If water vapor amount transported by convection is larger than that in a
! column, cloud mass flux is reduced.
!
! tendency of specific humidity is calculated tentatively
do k = 1, kmax
xyz_DQVapDtCumulus(:,:,k) = + xy_CldMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) / LatentHeat
end do
! total H2O mass in a vertical column after RAS
xyz_QH2OVapTentative = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
xy_CldMassFluxCorFactor = 1.0_DP
do k = 1, kmax
do j = 1, jmax
do i = 0, imax-1
if ( xyz_QH2OVapTentative(i,j,k) < 0.0_DP ) then
CldMassFluxCorFactor = xyz_QH2OVap(i,j,k) / ( xyz_QH2OVap(i,j,k) - xyz_QH2OVapTentative(i,j,k) )
else
CldMassFluxCorFactor = 1.0_DP
end if
if ( CldMassFluxCorFactor < xy_CldMassFluxCorFactor(i,j) ) then
xy_CldMassFluxCorFactor(i,j) = CldMassFluxCorFactor
end if
end do
end do
end do
! modify cloud mass flux
xy_CldMassFluxBottom = xy_CldMassFluxCorFactor * xy_CldMassFluxBottom
!!$ do k = 1, kmax
!!$ xyz_DQVapDtCumulus(:,:,k) = &
!!$ & + xy_CloudMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) &
!!$ & / LatentHeat
!!$ end do
!!$ ! total H2O mass in a vertical column before RAS
!!$ xyz_DelH2OMass = xyz_QH2OVap * xyz_DelPress / Grav
!!$ xy_H2OMassB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassB = xy_H2OMassB + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! total H2O mass in a vertical column after RAS
!!$ xyz_QH2OVapTentative = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
!!$ xyz_DelH2OMass = xyz_QH2OVapTentative * xyz_DelPress / Grav
!!$ xy_H2OMassA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassA = xy_H2OMassA + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! modify cloud mass flux
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xy_H2OMassA(i,j) < 0.0_DP ) then
!!$ ! A safety factor ( 1.0_DP + 1.0d-5 ) is arbitrary.
!!$ xy_CloudMassFluxBottom(i,j) = xy_CloudMassFluxBottom(i,j) &
!!$ & * xy_H2OMassB(i,j) &
!!$ & / ( ( xy_H2OMassB(i,j) - xy_H2OMassA(i,j) ) * ( 1.0_DP + 1.0d-5 ) )
!!$ end if
!!$ end do
!!$ end do
! Tendencies of specific temperature and humidity
!
do k = 1, kmax
xyz_DTempDtCumulus(:,:,k) = + xy_CldMassFluxBottom * xyz_GammaDSE(:,:,k) / CpDry
xyz_DQVapDtCumulus(:,:,k) = + xy_CldMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) / LatentHeat
end do
!!$ !
!!$ ! modification of tendency of temperature and water vapor in the mixed layer
!!$ !
!!$ if ( FlagUniformMixedLayer ) then
!!$ xy_SumTmp = 0.0_DP
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & + xyz_DTempDtCumulus(i,j,k) &
!!$ & * ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) )
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & / ( xyr_Press(i,j,0) - xyr_Press(i,j,xy_IndexMixLayTop(i,j)) )
!!$ end do
!!$ end do
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xyz_DTempDtCumulus(i,j,k) = xy_SumTmp(i,j)
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ !
!!$ xy_SumTmp = 0.0_DP
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & + xyz_DQVapDtCumulus(i,j,k) &
!!$ & * ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) )
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & / ( xyr_Press(i,j,0) - xyr_Press(i,j,xy_IndexMixLayTop(i,j)) )
!!$ end do
!!$ end do
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xyz_DQVapDtCumulus(i,j,k) = xy_SumTmp(i,j)
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ end if
! add tendencies to temperature and specific humidity
!
xyz_Temp = xyz_Temp + xyz_DTempDtCumulus * 2.0_DP * DelTime
xyz_QH2OVap = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
! Precipitation rate at cloud top level
! unit is kg m-2 s-1
!
xyz_RainCumulus(:,:,l) = xy_CldMassFluxBottom * xyz_DetCldWatCondFactor(:,:,l) * xy_NormMassFluxCldTop * xy_CldQH2OLiqCldTop
! mass fix
!
xyz_DelH2OMass = xyz_QH2OVap * xyz_DelPress / Grav
! total H2O mass in a vertical column
xy_H2OMassB = 0.0_DP
do k = kmax, 1, -1
xy_H2OMassB = xy_H2OMassB + xyz_DelH2OMass(:,:,k)
end do
do j = 1, jmax
do i = 0, imax-1
if ( xy_H2OMassB(i,j) < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
call MessageNotify( 'M', module_name, 'Mass of water vapor in a column is negative (%d,%d), %f.', i = (/i,j/), d = (/xy_H2OMassB(i,j)/) )
end if
end do
end do
! negative mass is borrowed from above
do k = 1, kmax-1
do j = 1, jmax
do i = 0, imax-1
if ( xyz_DelH2OMass(i,j,k) < 0.0_DP ) then
xyz_DelH2OMass(i,j,k+1) = xyz_DelH2OMass(i,j,k+1) + xyz_DelH2OMass(i,j,k)
xyz_DelH2OMass(i,j,k ) = 0.0_DP
end if
end do
end do
end do
k = kmax
do j = 1, jmax
do i = 0, imax-1
if ( xyz_DelH2OMass(i,j,k) < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'Mass of water vapor in the top layer is negative (%d,%d,%d), %f.', &
!!$ & i = (/i,j,k/), d = (/xyz_DelH2OMass(i,j,k)/) )
!!$
!!$ xyz_RainCumulus(i,j,l) = xyz_RainCumulus(i,j,l) &
!!$ & - xyz_DelH2OMass(i,j,k) / ( 2.0_DP * DelTime )
!!$ xyz_Temp (i,j,k) = xyz_Temp(i,j,k) &
!!$ & - LatentHeat * xyz_DelH2OMass(i,j,k) / ( xyz_DelPress(i,j,k) / Grav )&
!!$ & / CpDry
xyz_DelH2OMass (i,j,k) = 0.0_DP
end if
end do
end do
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xyz_RainCumulus(i,j,l) < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'Mass of water vapor is insufficient at (%d,%d,%d), %f.', &
!!$ & i = (/i,j,k/), d = (/xyz_RainCumulus(i,j,l)/) )
!!$ end if
!!$ end do
!!$ end do
! total H2O mass in a vertical column, again
xy_H2OMassA = 0.0_DP
do k = kmax, 1, -1
xy_H2OMassA = xy_H2OMassA + xyz_DelH2OMass(:,:,k)
end do
! total mass in a vertical column is adjusted
do j = 1, jmax
do i = 0, imax-1
if ( xy_H2OMassA(i,j) > 0.0_DP ) then
!!$ write( 6, * ) i, j, xy_H2OMassB(i,j), xy_H2OMassB(i,j) / xy_H2OMassA(i,j)
do k = 1, kmax
xyz_DelH2OMass(i,j,k) = xyz_DelH2OMass(i,j,k) * xy_H2OMassB(i,j) / xy_H2OMassA(i,j)
end do
else
do k = 1, kmax
xyz_DelH2OMass(i,j,k) = 0.0_DP
end do
end if
end do
end do
xyz_QH2OVap = xyz_DelH2OMass / ( xyz_DelPress / Grav )
! Detrainment mass tendency per unit mass (kg m-3 s-1 / ( kg m-3 ) = s-1).
! This corresponds to condensation rate (kg m-2 s-1) divided by layer thickness (m)
! and density (kg m-3), in other words.
! kg m-2 s-1 / ( Pa / ( m s-2 ) )
! = kg m-2 s-1 Pa-1 m s-1 = kg m-2 (kg m s-2 m-2)-1 m s-2
! = kg m-2 s-1 kg-1 m-1 s2 m2 m s-2 = s-1
if ( present( xyz_MoistConvDetTend ) ) then
xyz_MoistConvDetTend(:,:,l) = xy_CldMassFluxBottom * xy_NormMassFluxCldTop / ( xyz_DelPress(:,:,l) / Grav )
end if
if ( present( xyz_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
do k = 1, l-1
do j = 1, jmax
do i = 0, imax-1
if ( k > xy_IndexMixLayTop(i,j) ) then
DelNormMassFluxHalfLayer = - xy_EntParam(i,j) * xyz_BetaCldTop(i,j,k) * xyz_PotTemp(i,j,k)
NormMassFlux = xyr_NormMassFlux(i,j,k-1) - DelNormMassFluxHalfLayer
xyz_MoistConvSubsidMassFlux(i,j,k) = xyz_MoistConvSubsidMassFlux(i,j,k) + xy_CldMassFluxBottom(i,j) * NormMassFlux
end if
end do
end do
end do
end if
end do loop_cloud_top
! 温度変化率, 比湿変化率
! Calculate specific humidity tendency and temperature tendency
! (In fact, temperature tendency does not need to calculate, here.)
!
xyz_DTempDtCumulus = ( xyz_Temp - xyz_TempB ) / ( 2.0_DP * DelTime )
xyz_DQVapDtCumulus = ( xyz_QH2OVap - xyz_QH2OVapB ) / ( 2.0_DP * DelTime )
! Precipitation rate at the surface
! unit is kg m-2 s-1
!
!!$ xy_RainCumulus = 0.0d0
!!$ do k = kmax, 1, -1
!!$ xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
!!$ end do
xyz_DQH2OLiqDt = xyz_RainCumulus / ( xyz_DelPress / Grav )
!!$ xyz_RainCumulus = xyz_DQH2OLiqDt * ( xyz_DelPress / Grav )
!!$ xy_RainCumulus = 0.0d0
!!$ do k = kmax, 1, -1
!!$ xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
!!$ end do
!!$
!!$ xy_Rain = xy_Rain + xy_RainCumulus
xyz_QH2OLiqB = 0.0_DP
xyz_QH2OLiq = xyz_DQH2OLiqDt * 2.0_DP * DelTime
call RASChkCons( xyr_Press, xyz_TempB, xyz_QH2OVapB, xyz_QH2OLiqB, xyz_Temp , xyz_QH2OVap , xyz_QH2OLiq )
! calculation for output
xyz_RainCumulus = xyz_DQH2OLiqDt * ( xyz_DelPress / Grav )
xy_RainCumulus = 0.0d0
do k = kmax, 1, -1
xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
end do
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'RainCumulus' , xy_RainCumulus * LatentHeat )
call HistoryAutoPut( TimeN, 'DTempDtCumulus' , xyz_DTempDtCumulus )
call HistoryAutoPut( TimeN, 'DQH2OVapDtCumulus' , xyz_DQVapDtCumulus )
call HistoryAutoPut( TimeN, 'RASMassFluxDistFunc', xyz_MassFluxDistFunc )
call HistoryAutoPut( TimeN, 'RASEntParam' , xyz_EntParam )
call HistoryAutoPut( TimeN, 'RASCWF' , xyz_CWF )
call HistoryAutoPut( TimeN, 'RASCWFCrtl' , xyz_CWFCrtl )
call HistoryAutoPut( TimeN, 'RASDCWFDtLS' , xyz_DCWFDtLS )
!!$ call HistoryAutoPut( TimeN, 'RASMixLayTopIndex' , real( xy_IndexMixLayTop ) )
!!$ if ( present( xyz_DQH2OLiqDt ) ) then
!!$
!!$ ! unit is kg m-2 s-1
!!$ xyz_DDelLWDtCCPLV = xyz_RainCumulus
!!$
!!$ ! 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_DDelLWDtCCPLV(i,j,k) = xyz_DDelLWDtCCPLV(i,j,k) + xy_NegDDelLWDt(i,j)
!!$ if ( xyz_DDelLWDtCCPLV(i,j,k) < 0.0d0 ) then
!!$ xy_NegDDelLWDt(i,j) = xyz_DDelLWDtCCPLV(i,j,k)
!!$ xyz_DDelLWDtCCPLV(i,j,k) = 0.0d0
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$
!!$ ! unit is s-1
!!$ xyz_DQH2OLiqDt = xyz_DDelLWDtCCPLV / ( xyz_DelPress / Grav )
!!$
!!$ end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine RAS
| Subroutine : | |||||
| xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in )
| ||||
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_Exner(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Exner(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
| ||||
| xyz_QH2OVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
| ||||
| xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_MoistConvDetTend(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional | ||||
| xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RAS1DWrapper3D( xy_SurfTemp, xyz_Press, xyr_Press, xyz_Exner, xyr_Exner, xyz_Temp, xyz_QH2OVap, xyz_DQH2OLiqDt, xyz_MoistConvDetTend, xyz_MoistConvSubsidMassFlux )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat
! $ L $ [J kg-1] .
! 凝結の潜熱.
! Latent heat of condensation
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: xyz_CalcQVapSat, xyz_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ArakawaSchubertL1982CalcCWFCrtl
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: xy_SurfTemp (0:imax-1, 1:jmax)
! Pressure
real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! Pressure
real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! Pressure
real(DP), intent(in ) :: xyz_Exner (0:imax-1, 1:jmax, 1:kmax)
! Exner function
real(DP), intent(in ) :: xyr_Exner (0:imax-1, 1:jmax, 0:kmax)
! Exner function
real(DP), intent(inout) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP), intent(inout) :: xyz_QH2OVap (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(out ) :: xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvDetTend (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: SurfTemp
! Pressure
real(DP) :: z_Press (1:kmax)
! Pressure
real(DP) :: r_Press (0:kmax)
! Pressure
real(DP) :: z_Exner (1:kmax)
! Exner function
real(DP) :: r_Exner (0:kmax)
! Exner function
real(DP) :: z_Temp (1:kmax)
! Temperature
real(DP) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP) :: z_DQH2OLiqDt(1:kmax)
real(DP) :: z_MoistConvDetTend (1:kmax)
real(DP) :: z_MoistConvSubsidMassFlux(1:kmax)
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_DelPress(0:imax-1, 1:jmax, 1:kmax)
! $ \Delta p $
!
!!$ real(DP) :: xyz_PotTemp (0:imax-1, 1:jmax, 1:kmax)
!!$ ! Potential temperature
!!$ !
!!$ real(DP) :: xyz_QH2OVapSat (0:imax-1, 1:jmax, 1:kmax)
!!$ ! 飽和比湿.
!!$ ! Saturation specific humidity.
! Dry and moist static energy in environment (Env) and cloud (Cld)
!
!!$ real(DP) :: xyz_EnvDryStaticEne (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyr_EnvDryStaticEne (0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xyz_EnvMoistStaticEne (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyr_EnvMoistStaticEne (0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xyz_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyr_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xyr_CldMoistStaticEne (0:imax-1, 1:jmax, 0:kmax)
!!$
!!$ real(DP) :: xy_Kernel (0:imax-1, 1:jmax)
!!$ ! Tendency of cloud work function by cumulus convection, kernel
!!$ real(DP) :: xy_CWF (0:imax-1, 1:jmax)
!!$ ! Cloud work function
real(DP) :: xyz_CWF (0:imax-1, 1:jmax, 1:kmax)
! Cloud work function
! (variable for output)
!!$ real(DP) :: xy_DCWFDtLS (0:imax-1, 1:jmax)
!!$ ! Tendency of cloud work function by large scale motion
real(DP) :: xyz_DCWFDtLS (0:imax-1, 1:jmax, 1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
!!$ real(DP) :: xy_CldMassFluxBottom (0:imax-1, 1:jmax)
!!$ ! Cloud mass flux at cloud bottom
!!$
!!$ real(DP) :: xyz_Beta (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyz_BetaCldTop (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyz_Gamma (0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ real(DP) :: xyz_GammaDSE (0:imax-1, 1:jmax, 1:kmax)
!!$ ! Tendency of dry static energy per unit mass flux
!!$ real(DP) :: xyz_GammaMSE (0:imax-1, 1:jmax, 1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
!!$
!!$ real(DP) :: xyz_Mu (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyz_Eps (0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ real(DP) :: xy_PressCldBase (0:imax-1, 1:jmax)
!!$ ! Pressure of cloud base
real(DP) :: xyz_CWFCrtl (0:imax-1, 1:jmax, 1:kmax)
! "Critical value" of cloud work function
!!$ real(DP) :: xyz_RainFactor (0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ real(DP) :: xy_EntParam (0:imax-1, 1:jmax)
!!$ ! Entrainment factor
real(DP) :: xyz_EntParam (0:imax-1, 1:jmax, 1:kmax)
! Entrainment factor (variable for output)
!!$ real(DP) :: xy_EntParamLL (0:imax-1, 1:jmax)
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! higher level
!!$ real(DP) :: xy_EntParamUL (0:imax-1, 1:jmax)
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! lower level
!!$
!!$ ! Difference of normalized mass flux between layer interface
!!$ real(DP) :: xyz_DelNormMassFlux (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_DelNormMassFluxCldTop(0:imax-1, 1:jmax)
!!$ ! Normalized mass flux at layer interface and cloud top
!!$ real(DP) :: xyr_NormMassFlux (0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xy_NormMassFluxCldTop (0:imax-1, 1:jmax)
!!$
!!$ ! Liquid water at cloud top
!!$ real(DP) :: xy_CldQH2OLiqCldTop (0:imax-1, 1:jmax)
! Mass flux distribution function
real(DP) :: xyz_MassFluxDistFunc (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xyz_DelH2OMass (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_H2OMassB (0:imax-1, 1:jmax)
!!$ real(DP) :: xy_H2OMassA (0:imax-1, 1:jmax)
!!$
real(DP) :: xyz_RainCumulus (0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ real(DP) :: xyz_DDelLWDtCCPLV(0:imax-1, 1:jmax, 1:kmax)
!!$
!!$ logical :: xy_FlagCrossSatEquivPotTemp(0:imax-1, 1:jmax)
!!$ !
!!$ ! Flag showing whether a parcel in cloud has moist static
!!$ ! energy larger than environment's
!!$
!!$ real(DP) :: xyr_QH2OVapSat (0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xyr_TempAdiabAscent (0:imax-1, 1:jmax, 0:kmax)
!!$ real(DP) :: xy_SurfPotTemp (0:imax-1, 1:jmax)
!!$ real(DP) :: xyz_TempAdiabAscent (0:imax-1, 1:jmax, 1:kmax)
!!$ ! Variables for looking for top of mixed layer
!!$ !
!!$ logical :: xy_FlagMixLayTopFound (0:imax-1, 1:jmax)
!!$ integer :: xy_IndexMixLayTop (0:imax-1, 1:jmax)
!!$
!!$
!!$ ! Variables for modification of cloud mass flux
!!$ !
!!$ real(DP) :: xyz_QH2OVapTentative (0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: CldMassFluxCorFactor
!!$ real(DP) :: xy_CldMassFluxCorFactor(0:imax-1, 1:jmax)
!!$
!!$ real(DP) :: xyz_QH2OVapB(0:imax-1, 1:jmax, 1:kmax)
!!$ ! 調節前の比湿.
!!$ ! Specific humidity before adjustment
!!$
!!$ ! Flags for modification of
!!$ !
!!$ logical :: xy_FlagKernelNegative (0:imax-1, 1:jmax)
!!$ logical :: xy_FlagNegH2OLiqCldTop(0:imax-1, 1:jmax)
!!$
!!$
!!$ ! Variables for subsidence mass flux between updrafts
!!$ !
!!$ real(DP) :: DelNormMassFluxHalfLayer
!!$ real(DP) :: NormMassFlux
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
!!$ real(DP) :: xy_SumTmp(0:imax-1, 1:jmax)
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 :: l
!!$ integer :: m
!!$ integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
do j = 1, jmax
do i = 0 , imax-1
SurfTemp = xy_SurfTemp(i,j)
do k = 1, kmax
z_Press (k) = xyz_Press (i,j,k)
z_Exner (k) = xyz_Exner (i,j,k)
z_Temp (k) = xyz_Temp (i,j,k)
z_QH2OVap(k) = xyz_QH2OVap(i,j,k)
end do
do k = 0, kmax
r_Press (k) = xyr_Press (i,j,k)
r_Exner (k) = xyr_Exner (i,j,k)
end do
call RAS1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_DQH2OLiqDt, z_MoistConvDetTend, z_MoistConvSubsidMassFlux )
do k = 1, kmax
xyz_Temp (i,j,k) = z_Temp (k)
xyz_QH2OVap (i,j,k) = z_QH2OVap (k)
xyz_DQH2OLiqDt(i,j,k) = z_DQH2OLiqDt(k)
end do
if ( present( xyz_MoistConvDetTend ) ) then
do k = 1, kmax
xyz_MoistConvDetTend(i,j,k) = z_MoistConvDetTend(k)
end do
end if
if ( present( xyz_MoistConvSubsidMassFlux ) ) then
do k = 1, kmax
xyz_MoistConvSubsidMassFlux(i,j,k) = z_MoistConvSubsidMassFlux(k)
end do
end if
end do
end do
! calculation for output
do k = 1, kmax
xyz_DelPress(:,:,k) = xyr_Press(:,:,k-1) - xyr_Press(:,:,k)
end do
xyz_RainCumulus = xyz_DQH2OLiqDt * ( xyz_DelPress / Grav )
xy_RainCumulus = 0.0d0
do k = kmax, 1, -1
xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
end do
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'RainCumulus' , xy_RainCumulus * LatentHeat )
call HistoryAutoPut( TimeN, 'DTempDtCumulus' , xyz_DTempDtCumulus )
call HistoryAutoPut( TimeN, 'DQH2OVapDtCumulus' , xyz_DQVapDtCumulus )
call HistoryAutoPut( TimeN, 'DQH2OLiqDtCumulus' , xyz_DQH2OLiqDt )
call HistoryAutoPut( TimeN, 'RASMassFluxDistFunc', xyz_MassFluxDistFunc )
call HistoryAutoPut( TimeN, 'RASEntParam' , xyz_EntParam )
call HistoryAutoPut( TimeN, 'RASCWF' , xyz_CWF )
call HistoryAutoPut( TimeN, 'RASCWFCrtl' , xyz_CWFCrtl )
call HistoryAutoPut( TimeN, 'RASDCWFDtLS' , xyz_DCWFDtLS )
!!$ call HistoryAutoPut( TimeN, 'RASMixLayTopIndex' , real( xy_IndexMixLayTop ) )
!!$ if ( present( xyz_DQH2OLiqDt ) ) then
!!$
!!$ ! unit is kg m-2 s-1
!!$ xyz_DDelLWDtCCPLV = xyz_RainCumulus
!!$
!!$ ! 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_DDelLWDtCCPLV(i,j,k) = xyz_DDelLWDtCCPLV(i,j,k) + xy_NegDDelLWDt(i,j)
!!$ if ( xyz_DDelLWDtCCPLV(i,j,k) < 0.0d0 ) then
!!$ xy_NegDDelLWDt(i,j) = xyz_DDelLWDtCCPLV(i,j,k)
!!$ xyz_DDelLWDtCCPLV(i,j,k) = 0.0d0
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$
!!$ ! unit is s-1
!!$ xyz_DQH2OLiqDt = xyz_DDelLWDtCCPLV / ( xyz_DelPress / Grav )
!!$
!!$ end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine RAS1DWrapper3D
| Subroutine : |
moist_conv_adjust モジュールの初期化を行います. NAMELIST#moist_conv_adjust_nml の読み込みはこの手続きで行われます.
"moist_conv_adjust" module is initialized. "NAMELIST#moist_conv_adjust_nml" is loaded in this procedure.
This procedure input/output NAMELIST#relaxed_arakawa_schubert .
subroutine RASInit
!
! moist_conv_adjust モジュールの初期化を行います.
! NAMELIST#moist_conv_adjust_nml の読み込みはこの手続きで行われます.
!
! "moist_conv_adjust" module is initialized.
! "NAMELIST#moist_conv_adjust_nml" is loaded in this procedure.
!
! モジュール引用 ; USE statements
!
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! 文字列操作
! Character handling
!
use dc_string, only: StoA
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoAddVariable
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ArakawaSchubertL1982Init
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: SaturateInit
! 宣言文 ; Declaration statements
!
implicit none
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
character(STRING) :: VarName
integer:: k
! NAMELIST 変数群
! NAMELIST group name
!
namelist /relaxed_arakawa_schubert/ AdjTimeConst, DetCldWatCondFactor0, DetCldIceCondFactor0, RainSnowConvFactor0Press, RainSnowConvFactor1Press, RainSnowConvFactor0, RainSnowConvFactor1, FlagZeroCrtlCWF, FlagColumnRearrangement, FlagMomMix, FlagEntCond, FlagPRCPEvap, PRCPArea, PRCPEvapArea, RASSupressFactor
! デフォルト値については初期化手続 "moist_conv_adjust#CumAdjInit"
! のソースコードを参照のこと.
!
! Refer to source codes in the initialization procedure
! "moist_conv_adjust#MoistConvAdjustInit" for the default values.
!
! 実行文 ; Executable statement
!
if ( relaxed_arakawa_schubert_inited ) return
! デフォルト値の設定
! Default values settings
!
!!$ FlagUse = .true.
!!$ FlagUniformMixedLayer = .false.
AdjTimeConst = 7200.0_DP
!!$ DetCldWatCondFactor0 = -1.0_DP
DetCldWatCondFactor0 = 1.0_DP
!!$ DetCldIceCondFactor0 = -1.0_DP
DetCldIceCondFactor0 = 1.0_DP
RainSnowConvFactor0Press = 1.0e10_DP
RainSnowConvFactor1Press = RainSnowConvFactor0Press + 1.0_DP
RainSnowConvFactor0 = 0.0_DP
RainSnowConvFactor1 = 0.0_DP
FlagZeroCrtlCWF = .false.
FlagColumnRearrangement = .true.
FlagMomMix = .false.
FlagEntCond = .true.
FlagUpWind = .true.
FlagPRCPEvap = .false.
!!$ PRCPEvapArea = 0.5_DP
PRCPArea = 1.0_DP
!!$ PRCPArea = 0.5_DP
PRCPEvapArea = 1.0_DP
!!$ PRCPEvapArea = 0.5_DP
RASSupressFactor = 0.0_DP
! NAMELIST の読み込み
! NAMELIST is input
!
if ( trim(namelist_filename) /= '' ) then
call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in)
rewind( unit_nml )
read( unit_nml, nml = relaxed_arakawa_schubert, iostat = iostat_nml ) ! (out)
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
end if
! Check values
!
if ( DetCldWatCondFactor0 > 1.0_DP ) then
call MessageNotify( 'E', module_name, 'DetCldWatCondFactor0 is %f, but it must be less than or equal to 1', d = (/ DetCldWatCondFactor0 /) )
end if
if ( DetCldIceCondFactor0 > 1.0_DP ) then
call MessageNotify( 'E', module_name, 'DetCldIceCondFactor0 is %f, but it must be less than or equal to 1', d = (/ DetCldIceCondFactor0 /) )
end if
if ( ( RainSnowConvFactor0 < 0.0_DP ) .and. ( RainSnowConvFactor0 > 1.0_DP ) ) then
call MessageNotify( 'E', module_name, 'RainSnowConvFactor0 is %f, but it must be >= 0 and <= 1.', d = (/ RainSnowConvFactor0 /) )
end if
if ( ( RainSnowConvFactor1 < 0.0_DP ) .and. ( RainSnowConvFactor1 > 1.0_DP ) ) then
call MessageNotify( 'E', module_name, 'RainSnowConvFactor1 is %f, but it must be >= 0 and <= 1.', d = (/ RainSnowConvFactor1 /) )
end if
if ( RainSnowConvFactor0Press >= RainSnowConvFactor1Press ) then
call MessageNotify( 'E', module_name, 'RainSnowConvFactor0Press, %f, has to be smaller than RainSnowConvFctor1Press, %f.', d = (/ RainSnowConvFactor0Press, RainSnowConvFactor1Press /) )
end if
if ( ( .not. FlagEntCond ) .and. ( FlagUpWind ) ) then
call MessageNotify( 'E', module_name, 'Option for upwind scheme for non-entrainment of ice version is not supported.' )
end if
! ヒストリデータ出力のためのへの変数登録
! Register of variables for history data output
!
call HistoryAutoAddVariable( 'RainCumulus', (/ 'lon ', 'lat ', 'time' /), 'precipitation by cumulus scheme, RAS', 'W m-2' )
call HistoryAutoAddVariable( 'DTempDtCumulus', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cumulus condensation heating, RAS', 'K s-1' )
call HistoryAutoAddVariable( 'DQH2OVapDtCumulus', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cumulus condensation moistening, RAS', 'kg kg-1 s-1' )
call HistoryAutoAddVariable( 'DQH2OLiqDtCumulus', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cumulus H2O liquid production rate, RAS', 'kg kg-1 s-1' )
call HistoryAutoAddVariable( 'DQH2OSolDtCumulus', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cumulus H2O solid procuction rate, RAS', 'kg kg-1 s-1' )
call HistoryAutoAddVariable( 'RASMassFluxDistFunc', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'mass flux distribution function, RAS', 'kg m-2 s-1' )
call HistoryAutoAddVariable( 'RASEntParam', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'entrainment parameter', 'm-1' )
call HistoryAutoAddVariable( 'RASCWF', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cloud work function', 'J kg-1' )
call HistoryAutoAddVariable( 'RASCWFCrtl', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'critical cloud work function', 'J kg-1' )
call HistoryAutoAddVariable( 'RASDCWFDtLS', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'time derivative of cloud work function by large scale', 'J kg-1 s-1' )
!!$ call HistoryAutoAddVariable( 'RASMixLayTopIndex', &
!!$ & (/ 'lon ', 'lat ', 'time' /), &
!!$ & 'index of top of mixed layer', '1' )
call HistoryAutoAddVariable( 'CldMassFluxCorFactor', (/ 'lon ', 'lat ', 'sig ', 'time' /), 'cloud mass flux correction factor', '1' )
!!$ do k = 1, kmax
!!$ write( VarName, '(a,i3.3)' ) 'RASCldTemp', k
!!$ call HistoryAutoAddVariable( Varname, &
!!$ & (/ 'lon ', 'lat ', 'sigm', 'time' /), &
!!$ & 'temperature of cloud air', 'K' )
!!$ write( VarName, '(a,i3.3)' ) 'RASCldQH2OVap', k
!!$ call HistoryAutoAddVariable( Varname, &
!!$ & (/ 'lon ', 'lat ', 'sigm', 'time' /), &
!!$ & 'mixing ratio of water vapor in cloud', '1' )
!!$ write( VarName, '(a,i3.3)' ) 'RASCldQH2OLiq', k
!!$ call HistoryAutoAddVariable( Varname, &
!!$ & (/ 'lon ', 'lat ', 'sigm', 'time' /), &
!!$ & 'mixing ratio of liquid water in cloud', '1' )
!!$ end do
! Initialization of modules used in this module
!
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
call ArakawaSchubertL1982Init
! Initialization of modules used in this module
!
call SaturateInit
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
!!$ call MessageNotify( 'M', module_name, ' FlagUse = %b', l = (/ FlagUse /) )
!!$ call MessageNotify( 'M', module_name, ' FlagUniformMixedLayer = %b', l = (/ FlagUniformMixedLayer /) )
call MessageNotify( 'M', module_name, ' AdjTimeConst = %f', d = (/ AdjTimeConst /) )
call MessageNotify( 'M', module_name, ' DetCldWatCondFactor0 = %f', d = (/ DetCldWatCondFactor0 /) )
call MessageNotify( 'M', module_name, ' DetCldIceCondFactor0 = %f', d = (/ DetCldIceCondFactor0 /) )
call MessageNotify( 'M', module_name, ' RainSnowConvFactor0Press = %f', d = (/ RainSnowConvFactor0Press /) )
call MessageNotify( 'M', module_name, ' RainSnowConvFactor1Press = %f', d = (/ RainSnowConvFactor1Press /) )
call MessageNotify( 'M', module_name, ' RainSnowConvFactor0 = %f', d = (/ RainSnowConvFactor0 /) )
call MessageNotify( 'M', module_name, ' RainSnowConvFactor1 = %f', d = (/ RainSnowConvFactor1 /) )
call MessageNotify( 'M', module_name, ' FlagZeroCrtlCWF = %b', l = (/ FlagZeroCrtlCWF /) )
call MessageNotify( 'M', module_name, ' FlagColumnRearrangement = %b', l = (/ FlagColumnRearrangement /) )
call MessageNotify( 'M', module_name, ' FlagMomMix = %b', l = (/ FlagMomMix /) )
call MessageNotify( 'M', module_name, ' FlagEntCond = %b', l = (/ FlagEntCond /) )
call MessageNotify( 'M', module_name, ' FlagUpWind = %b', l = (/ FlagEntCond /) )
call MessageNotify( 'M', module_name, 'FlagPRCPEvap = %b', l = (/ FlagPRCPEvap /) )
call MessageNotify( 'M', module_name, 'PRCPArea = %f', d = (/ PRCPArea /) )
call MessageNotify( 'M', module_name, 'PRCPEvapArea = %f', d = (/ PRCPEvapArea /) )
call MessageNotify( 'M', module_name, 'RASSupressFactor = %f', d = (/ RASSupressFactor /) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
relaxed_arakawa_schubert_inited = .true.
end subroutine RASInit
| Subroutine : | |||
| xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in )
| ||
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
| xyz_Exner(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyr_Exner(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgTemp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgQH2OVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgQH2OLiq(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgQH2OSol(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgU(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in )
| ||
| xyz_ArgV(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in )
| ||
| xyz_DTempDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||
| xyz_DQH2OVapDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||
| xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||
| xyz_DQH2OSolDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||
| xyz_DUDt(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out ) | ||
| xyz_DVDt(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out ) | ||
| xy_SurfRainFlux(0:imax-1, 1:jmax) : | real(DP), intent(out )
| ||
| xy_SurfSnowFlux(0:imax-1, 1:jmax) : | real(DP), intent(out )
| ||
| xyz_MoistConvDetTend(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1DWrapper3DWrapper( xy_SurfTemp, xyz_Press, xyr_Press, xyz_Exner, xyr_Exner, xyz_ArgTemp, xyz_ArgQH2OVap, xyz_ArgQH2OLiq, xyz_ArgQH2OSol, xyz_ArgU, xyz_ArgV, xyz_DTempDt, xyz_DQH2OVapDt, xyz_DQH2OLiqDt, xyz_DQH2OSolDt, xyz_DUDt, xyz_DVDt, xy_SurfRainFlux, xy_SurfSnowFlux, xyz_MoistConvDetTend, xyz_MoistConvSubsidMassFlux )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
!
! Rearrangement of column
!
use rearrange_column, only : RearrangeColumn
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: xy_SurfTemp (0:imax-1, 1:jmax)
! Pressure
real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! Pressure
real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! Pressure
real(DP), intent(in ) :: xyz_Exner (0:imax-1, 1:jmax, 1:kmax)
! Exner function
real(DP), intent(in ) :: xyr_Exner (0:imax-1, 1:jmax, 0:kmax)
! Exner function
real(DP), intent(in ) :: xyz_ArgTemp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP), intent(in ) :: xyz_ArgQH2OVap(0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(in ) :: xyz_ArgQH2OLiq(0:imax-1, 1:jmax, 1:kmax)
! Specific liquid water content
real(DP), intent(in ) :: xyz_ArgQH2OSol(0:imax-1, 1:jmax, 1:kmax)
! Specific ice content
real(DP), intent(in ) :: xyz_ArgU (0:imax-1,1:jmax,1:kmax)
! Zonal wind
real(DP), intent(in ) :: xyz_ArgV (0:imax-1,1:jmax,1:kmax)
! Meridional wind
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OVapDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OSolDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DUDt (0:imax-1,1:jmax,1:kmax)
real(DP), intent(out ) :: xyz_DVDt (0:imax-1,1:jmax,1:kmax)
real(DP), intent(out ) :: xy_SurfRainFlux(0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP), intent(out ) :: xy_SurfSnowFlux(0:imax-1, 1:jmax)
! 降雪量.
! Snow
real(DP), intent(out ), optional :: xyz_MoistConvDetTend (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP) :: xyz_QH2OVap(0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP) :: xyz_QH2OLiq(0:imax-1, 1:jmax, 1:kmax)
! Specific liquid water content
real(DP) :: xyz_QH2OSol(0:imax-1, 1:jmax, 1:kmax)
! Specific ice content
real(DP) :: xyz_U (0:imax-1,1:jmax,1:kmax)
! Zonal wind
real(DP) :: xyz_V (0:imax-1,1:jmax,1:kmax)
! Meridional wind
real(DP), allocatable :: xya_Data(:,:,:)
real(DP) :: xy_LVSurfTemp (0:imax-1, 1:jmax)
real(DP) :: xyz_LVPress (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyr_LVPress (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyz_LVExner (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyr_LVExner (0:imax-1, 1:jmax, 0:kmax)
real(DP) :: xyz_LVMoistConvDetTend (0:imax-1, 1:jmax, 1:kmax)
real(DP) :: xyz_LVMoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax)
integer :: ks
integer :: ke
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
!!$ ! 計算時間計測開始
!!$ ! Start measurement of computation time
!!$ !
!!$ call TimesetClockStart( module_name )
xyz_Temp = xyz_ArgTemp
xyz_QH2OVap = xyz_ArgQH2OVap
xyz_QH2OLiq = xyz_ArgQH2OLiq
xyz_QH2OSol = xyz_ArgQH2OSol
xyz_U = xyz_ArgU
xyz_V = xyz_ArgV
if ( FlagColumnRearrangement ) then
!
! Rearrangement of column
!
allocate( xya_Data( 0:imax-1, 1:jmax, (1)+8*(kmax)+2*(kmax+1) ) )
ke = 0
ks = ke + 1
ke = ks + 1 - 1
xya_Data(:,:,ks) = xy_SurfTemp
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_Press
ks = ke + 1
ke = ks + kmax+1 - 1
xya_Data(:,:,ks:ke) = xyr_Press
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_Exner
ks = ke + 1
ke = ks + kmax+1 - 1
xya_Data(:,:,ks:ke) = xyr_Exner
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_Temp
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_QH2OVap
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_QH2OLiq
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_QH2OSol
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_U
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_V
call RearrangeColumn( xya_Data )
ke = 0
ks = ke + 1
ke = ks + 1 - 1
xy_LVSurfTemp = xya_Data(:,:,ks)
ks = ke + 1
ke = ks + kmax - 1
xyz_LVPress = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax+1 - 1
xyr_LVPress = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_LVExner = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax+1 - 1
xyr_LVExner = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_Temp = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_QH2OVap = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_QH2OLiq = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_QH2OSol = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_U = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_V = xya_Data(:,:,ks:ke)
deallocate( xya_Data )
call RASWithIce1DWrapper3D( xy_LVSurfTemp, xyz_LVPress, xyr_LVPress, xyz_LVExner, xyr_LVExner, xyz_Temp, xyz_QH2OVap, xyz_QH2OLiq, xyz_QH2OSol, xyz_U, xyz_V, xyz_DTempDt, xyz_DQH2OVapDt, xyz_DQH2OLiqDt, xyz_DQH2OSolDt, xyz_DUDt, xyz_DVDt, xy_SurfRainFlux, xy_SurfSnowFlux, xyz_LVMoistConvDetTend, xyz_LVMoistConvSubsidMassFlux )
!
! Rearrangement of column
!
allocate( xya_Data( 0:imax-1, 1:jmax, 8*(kmax)+2*1 ) )
ke = 0
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DTempDt
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DQH2OVapDt
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DQH2OLiqDt
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DQH2OSolDt
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DUDt
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_DVDt
ks = ke + 1
ke = ks + 1 - 1
xya_Data(:,:,ks ) = xy_SurfRainFlux
ks = ke + 1
ke = ks + 1 - 1
xya_Data(:,:,ks ) = xy_SurfSnowFlux
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_LVMoistConvDetTend
ks = ke + 1
ke = ks + kmax - 1
xya_Data(:,:,ks:ke) = xyz_LVMoistConvSubsidMassFlux
call RearrangeColumn( xya_Data )
ke = 0
ks = ke + 1
ke = ks + kmax - 1
xyz_DTempDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_DQH2OVapDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_DQH2OLiqDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_DQH2OSolDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_DUDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + kmax - 1
xyz_DVDt = xya_Data(:,:,ks:ke)
ks = ke + 1
ke = ks + 1 - 1
xy_SurfRainFlux = xya_Data(:,:,ks)
ks = ke + 1
ke = ks + 1 - 1
xy_SurfSnowFlux = xya_Data(:,:,ks)
ks = ke + 1
ke = ks + kmax - 1
if ( present( xyz_MoistConvDetTend ) ) then
xyz_MoistConvDetTend = xya_Data(:,:,ks:ke)
end if
ks = ke + 1
ke = ks + kmax - 1
if ( present( xyz_MoistConvSubsidMassFlux ) ) then
xyz_MoistConvSubsidMassFlux = xya_Data(:,:,ks:ke)
end if
deallocate( xya_Data )
else
call RASWithIce1DWrapper3D( xy_SurfTemp, xyz_Press, xyr_Press, xyz_Exner, xyr_Exner, xyz_Temp, xyz_QH2OVap, xyz_QH2OLiq, xyz_QH2OSol, xyz_U, xyz_V, xyz_DTempDt, xyz_DQH2OVapDt, xyz_DQH2OLiqDt, xyz_DQH2OSolDt, xyz_DUDt, xyz_DVDt, xy_SurfRainFlux, xy_SurfSnowFlux, xyz_MoistConvDetTend, xyz_MoistConvSubsidMassFlux )
end if
!!$ ! 計算時間計測一時停止
!!$ ! Pause measurement of computation time
!!$ !
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1DWrapper3DWrapper
| Variable : | |||
| DetCldIceCondFactor0 : | real(DP), save
|
| Variable : | |||
| DetCldWatCondFactor0 : | real(DP), save
|
| Variable : | |||
| FlagColumnRearrangement : | logical , save
|
| Variable : | |||
| FlagZeroCrtlCWF : | logical , save
|
| Subroutine : | |||||
| SurfTemp : | real(DP), intent(in )
| ||||
| z_Press(1:kmax) : | real(DP), intent(in )
| ||||
| r_Press(0:kmax) : | real(DP), intent(in )
| ||||
| z_Exner(1:kmax) : | real(DP), intent(in )
| ||||
| r_Exner(0:kmax) : | real(DP), intent(in )
| ||||
| z_Temp(1:kmax) : | real(DP), intent(inout)
| ||||
| z_QH2OVap(1:kmax) : | real(DP), intent(inout)
| ||||
| z_DQH2OLiqDt(1:kmax) : | real(DP), intent(out ) | ||||
| z_MoistConvDetTend(1:kmax) : | real(DP), intent(out ), optional | ||||
| z_MoistConvSubsidMassFlux(1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RAS1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_DQH2OLiqDt, z_MoistConvDetTend, z_MoistConvSubsidMassFlux )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat
! $ L $ [J kg-1] .
! 凝結の潜熱.
! Latent heat of condensation
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: SurfTemp
! Pressure
real(DP), intent(in ) :: z_Press (1:kmax)
! Pressure
real(DP), intent(in ) :: r_Press (0:kmax)
! Pressure
real(DP), intent(in ) :: z_Exner (1:kmax)
! Exner function
real(DP), intent(in ) :: r_Exner (0:kmax)
! Exner function
real(DP), intent(inout) :: z_Temp (1:kmax)
! Temperature
real(DP), intent(inout) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: z_DQH2OLiqDt(1:kmax)
real(DP), intent(out ), optional :: z_MoistConvDetTend (1:kmax)
real(DP), intent(out ), optional :: z_MoistConvSubsidMassFlux(1:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_Height (1:kmax)
!
! Height
real(DP) :: r_Height (0:kmax)
!
! Height
real(DP) :: RainCumulus
! 降水量.
! Precipitation
real(DP) :: z_DTempDtCumulus (1:kmax)
! 温度変化率.
! Temperature tendency
real(DP) :: z_DQVapDtCumulus (1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP) :: z_PotTemp (1:kmax)
! Potential temperature
!
real(DP) :: z_QH2OVapSat(1:kmax)
! 飽和比湿.
! Saturation specific humidity.
! Dry and moist static energy in environment (Env) and cloud (Cld)
!
real(DP) :: z_EnvDryStaticEne (1:kmax)
real(DP) :: r_EnvDryStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEne (1:kmax)
real(DP) :: r_EnvMoistStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEneSat(1:kmax)
real(DP) :: r_EnvMoistStaticEneSat(0:kmax)
real(DP) :: r_CldMoistStaticEne (0:kmax)
real(DP) :: Kernel
! Tendency of cloud work function by cumulus convection, kernel
real(DP) :: CWF
! Cloud work function
real(DP) :: z_CWF(1:kmax)
! Cloud work function
! (variable for output)
real(DP) :: DCWFDtLS
! Tendency of cloud work function by large scale motion
real(DP) :: z_DCWFDtLS(1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
real(DP) :: CldMassFluxBottom
! Cloud mass flux at cloud bottom
real(DP) :: z_Beta (1:kmax)
real(DP) :: z_BetaCldTop (1:kmax)
real(DP) :: z_Gamma (1:kmax)
real(DP) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
real(DP) :: z_GammaMSE (1:kmax)
! Tendency of moist static energy per unit mass flux
real(DP) :: z_Mu (1:kmax)
real(DP) :: z_Eps (1:kmax)
real(DP) :: PressCldBase
! Pressure of cloud base
real(DP) :: z_CWFCrtl (1:kmax)
! "Critical value" of cloud work function
real(DP) :: z_DetCldWatCondFactor (1:kmax)
real(DP) :: EntParam
! Entrainment factor
real(DP) :: z_EntParam (1:kmax)
! Entrainment factor (variable for output)
real(DP) :: EntParamLL
! Entrainment factor for a cloud with top at one layer
! higher level
real(DP) :: EntParamUL
! Entrainment factor for a cloud with top at one layer
! lower level
! Difference of normalized mass flux between layer interface
real(DP) :: z_DelNormMassFlux (1:kmax)
real(DP) :: DelNormMassFluxCldTop
! Normalized mass flux at layer interface and cloud top
real(DP) :: r_NormMassFlux (0:kmax)
real(DP) :: NormMassFluxCldTop
! Liquid water at cloud top
real(DP) :: CldQH2OLiqCldTop
! Mass flux distribution function
real(DP) :: z_MassFluxDistFunc (1:kmax)
real(DP) :: z_DelH2OMass (1:kmax)
real(DP) :: H2OMassB
real(DP) :: H2OMassA
real(DP) :: z_RainCumulus (1:kmax)
!!$ real(DP) :: NegDDelLWDt
!!$ real(DP) :: z_DDelLWDtCCPLV(1:kmax)
!!$
!!$ logical :: FlagCrossSatEquivPotTemp
!!$ !
!!$ ! Flag showing whether a parcel in cloud has moist static
!!$ ! energy larger than environment's
real(DP) :: r_QH2OVapSat (0:kmax)
real(DP) :: r_TempAdiabAscent (0:kmax)
real(DP) :: SurfPotTemp
!!$ real(DP) :: xyz_TempAdiabAscent (0:imax-1, 1:jmax, 1:kmax)
! Variables for looking for top of mixed layer
!
logical :: FlagMixLayTopFound
integer :: IndexMixLayTop
! Variables for modification of cloud mass flux
!
real(DP) :: z_QH2OVapTentative (1:kmax)
real(DP) :: CldMassFluxCorFactor
real(DP) :: CldMassFluxCorFactorTentative
real(DP) :: z_TempB (1:kmax)
! 調節前の温度.
! Temperature before adjustment
real(DP) :: z_QH2OVapB(1:kmax)
! 調節前の比湿.
! Specific humidity before adjustment
! Flags for modification of
!
logical :: FlagKernelNegative
logical :: FlagNegH2OLiqCldTop
! Variables for subsidence mass flux between updrafts
!
real(DP) :: DelNormMassFluxHalfLayer
real(DP) :: NormMassFlux
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
real(DP) :: r_CldTotWater(0:kmax)
real(DP) :: CldTotWaterCldTop
real(DP) :: SumTmp
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer :: l
integer :: m
integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
! 調節前 "Temp", "QH2OVap" の保存
! Store "Temp", "QH2OVap" before adjustment
!
z_TempB = z_Temp
z_QH2OVapB = z_QH2OVap
! Preparation of variables
!
!
! Auxiliary variables
! Pressure difference between upper and lower interface of the layer
do k = 1, kmax
z_DelPress(k) = r_Press(k-1) - r_Press(k)
end do
! beta
do k = 1, kmax
z_Beta(k) = CpDry / Grav * ( r_Exner(k-1) - r_Exner(k) )
end do
do k = 1, kmax
z_BetaCldTop(k) = CpDry / Grav * ( r_Exner(k-1) - z_Exner(k) )
end do
!
! Search for top of mixed layer (lifting condensation level) based on
! a description in p.684 of Arakawa and Shubert (1974).
!
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
!
!====================================
!
!!$ xyz_TempAdiabAscent(:,:,1) = xyz_Temp(:,:,1)
!!$ do k = 2, kmax
!!$ xyz_TempAdiabAscent(:,:,k) = &
!!$ & xyz_Temp(:,:,1) - Grav / CpDry * ( xyz_Height(:,:,k) - xyz_Height(:,:,1) )
!!$ end do
!!$ xyz_TempAdiabAscent = max( xyz_TempAdiabAscent, 1.0_DP )
!!$ xyz_QH2OVapSat = xyz_CalcQVapSat( xyz_TempAdiabAscent, xyz_Press )
!!$ xy_IndexMixLayTop = 1
!!$ xy_FlagMixLayTopFound = .false.
!!$ do k = 2, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xyz_QH2OVap(i,j,1) >= xyz_QH2OVapSat(i,j,k) ) .and. &
!!$ & ( .not. xy_FlagMixLayTopFound(i,j) ) ) then
!!$ xy_IndexMixLayTop (i,j) = k - 1
!!$ xy_FlagMixLayTopFound(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!
!------------------------------------
!
!!$ xyr_TempAdiabAscent(:,:,0) = xy_SurfTemp
!!$ do k = 1, kmax
!!$ xyr_TempAdiabAscent(:,:,k) = &
!!$ & xy_SurfTemp - Grav / CpDry * ( xyr_Height(:,:,k) - 0.0_DP )
!!$ end do
!!$ xyr_TempAdiabAscent = max( xyr_TempAdiabAscent, 1.0_DP )
!!$
r_TempAdiabAscent(0) = SurfTemp
SurfPotTemp = SurfTemp / r_Exner(0)
do k = 1, kmax
r_TempAdiabAscent(k) = SurfPotTemp * r_Exner(k)
end do
!
r_QH2OVapSat(0 ) = 1.0d100
r_QH2OVapSat(1:kmax-1) = a_CalcQVapSat( r_TempAdiabAscent(1:kmax-1), r_Press(1:kmax-1) )
r_QH2OVapSat(kmax ) = r_QH2OVapSat(kmax-1)
!
IndexMixLayTop = 1
FlagMixLayTopFound = .false.
do k = 2, kmax
if ( ( z_QH2OVap(1) >= r_QH2OVapSat(k) ) .and. ( .not. FlagMixLayTopFound ) ) then
IndexMixLayTop = k - 1
FlagMixLayTopFound = .true.
end if
end do
!
!====================================
!
if ( .not. FlagMixLayTopFound ) then
IndexMixLayTop = kmax - 1
end if
!
! Critical cloud work function
!
if ( FlagZeroCrtlCWF ) then
z_CWFCrtl = 0.0_DP
else
PressCldBase = r_Press(IndexMixLayTop)
call ASL1982CalcCWFCrtl1D( PressCldBase, z_Press, z_CWFCrtl )
end if
!
! Rain conversion factor
!
if ( DetCldWatCondFactor0 < 0.0_DP ) then
do k = 1, kmax
if ( z_Press(k) < 500.0d2 ) then
z_DetCldWatCondFactor(k) = 1.0_DP
else if ( z_Press(k) < 800.0d2 ) then
z_DetCldWatCondFactor(k) = 0.8_DP + ( 800.0d2 - z_Press(k) ) / 1500.0d2
else
z_DetCldWatCondFactor(k) = 0.8_DP
end if
end do
else
z_DetCldWatCondFactor = DetCldWatCondFactor0
end if
z_RainCumulus (1) = 0.0_DP
z_EntParam (1) = 0.0_DP
z_CWF (1) = 0.0_DP
z_DCWFDtLS (1) = 0.0_DP
z_MassFluxDistFunc(1) = 0.0_DP
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(1) = 0.0_DP
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
! Initialization
!
z_MoistConvSubsidMassFlux = 0.0_DP
end if
loop_cloud_top : do l = 2, kmax
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
! Potential temperature
!
z_PotTemp = z_Temp / z_Exner
! Saturation mixing ratio
!
z_QH2OVapSat = a_CalcQVapSat( z_Temp, z_Press )
! Calculation of dry and moist static energies
!
z_EnvDryStaticEne = CpDry * z_Temp + Grav * z_Height
z_EnvMoistStaticEne = z_EnvDryStaticEne + LatentHeat * z_QH2OVap
!
k = 0
r_EnvDryStaticEne (k) = 1.0d100
r_EnvMoistStaticEne(k) = 1.0d100
do k = 1, kmax-1
r_EnvDryStaticEne (k) = ( z_EnvDryStaticEne (k) + z_EnvDryStaticEne (k+1) ) / 2.0_DP
r_EnvMoistStaticEne(k) = ( z_EnvMoistStaticEne(k) + z_EnvMoistStaticEne(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvDryStaticEne (k) = z_EnvDryStaticEne (k)
r_EnvMoistStaticEne(k) = z_EnvMoistStaticEne(k)
! Calculation of saturated moist static energy
!
z_EnvMoistStaticEneSat = z_EnvDryStaticEne + LatentHeat * z_QH2OVapSat
!
k = 0
r_EnvMoistStaticEneSat(k) = 1.0d100
do k = 1, kmax-1
r_EnvMoistStaticEneSat(k) = ( z_EnvMoistStaticEneSat(k) + z_EnvMoistStaticEneSat(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvMoistStaticEneSat(k) = z_EnvMoistStaticEneSat(k)
! Entrainment parameter
!
call RASEntParam1D( l, z_Beta, z_BetaCldTop, z_PotTemp, z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, IndexMixLayTop, EntParam )
if ( l >= 3 ) then
call RASEntParam1D( l-1, z_Beta, z_BetaCldTop, z_PotTemp, z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, IndexMixLayTop, EntParamLL )
else
EntParamLL = 1.0d100
end if
if ( l <= kmax-1 ) then
call RASEntParam1D( l+1, z_Beta, z_BetaCldTop, z_PotTemp, z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, IndexMixLayTop, EntParamUL )
else
EntParamUL = 1.0d100
end if
! for output
z_EntParam(l) = EntParam
! Difference of normalized mass flux
!
! difference of normalized mass flux between layer bottom and top
!
z_DelNormMassFlux(1) = 1.0d100
do k = 2, l-1
z_DelNormMassFlux(k) = - EntParam * z_Beta(k) * z_PotTemp(k)
end do
do k = l, kmax
z_DelNormMassFlux(k) = 1.0d100
end do
!
! difference of normalized mass flux between layer bottom and mid-point
!
DelNormMassFluxCldTop = - EntParam * z_BetaCldTop(l) * z_PotTemp(l)
! Normalized mass flux
!
! normalized mass flux at layer interface
!
r_NormMassFlux(0) = 0.0_DP
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_NormMassFlux(k) = 0.0_DP
else if ( k == IndexMixLayTop ) then
r_NormMassFlux(k) = 1.0_DP
else
r_NormMassFlux(k) = r_NormMassFlux(k-1) - z_DelNormMassFlux(k)
end if
end do
do k = l, kmax
r_NormMassFlux(k) = 0.0_DP
end do
!
! normalized mass flux at cloud top (at layer mid-point)
!
NormMassFluxCldTop = r_NormMassFlux(l-1) - DelNormMassFluxCldTop
! Liquid water content at top of clouds
! If l is less than xy_IndexMixLayTop(i,j), i.e. the cloud top is below top of
! mixed layer, xy_SumTmp is zero, then, xy_CldQH2OLiqCldTop is also zero.
!
if ( l > IndexMixLayTop ) then
!!$ SumTmp = z_QH2OVap(IndexMixLayTop)
!!$ do k = IndexMixLayTop+1, l-1
!!$ SumTmp = SumTmp &
!!$ & - z_DelNormMassFlux(k) * z_QH2OVap(k)
!!$ end do
!!$ SumTmp = SumTmp &
!!$ & - DelNormMassFluxCldTop * z_QH2OVap(l)
do k = 0, IndexMixLayTop-1
r_CldTotWater(k) = 0.0_DP
end do
k = IndexMixLayTop
r_CldTotWater(k) = z_QH2OVap(IndexMixLayTop)
do k = IndexMixLayTop+1, l-1
r_CldTotWater(k) = r_CldTotWater(k-1) - z_DelNormMassFlux(k) * z_QH2OVap(k)
end do
CldTotWaterCldTop = r_CldTotWater(l-1) - DelNormMassFluxCldTop * z_QH2OVap(l)
do k = l, kmax
r_CldTotWater(k) = 0.0_DP
end do
else
r_CldTotWater = 0.0_DP
CldTotWaterCldTop = 0.0_DP
end if
CldQH2OLiqCldTop = CldTotWaterCldTop / ( NormMassFluxCldTop + 1.0d-100 ) - z_QH2OVapSat(l)
! Check whether kernel is positive or negative.
!
if ( CldQH2OLiqCldTop < 0.0_DP ) then
FlagNegH2OLiqCldTop = .true.
else
FlagNegH2OLiqCldTop = .false.
end if
! avoid negative value
CldQH2OLiqCldTop = max( CldQH2OLiqCldTop, 0.0_DP )
! Moist static energy in clouds
!
r_CldMoistStaticEne(0) = 1.0d100
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_CldMoistStaticEne(k) = 1.0d100
else if ( k == IndexMixLayTop ) then
r_CldMoistStaticEne(k) = z_EnvMoistStaticEne(IndexMixLayTop)
else
r_CldMoistStaticEne(k) = ( r_NormMassFlux(k-1) * r_CldMoistStaticEne(k-1) - z_DelNormMassFlux(k) * z_EnvMoistStaticEne(k) ) / r_NormMassFlux(k)
end if
end do
do k = l, kmax
r_CldMoistStaticEne(k) = 1.0d100
end do
!###############################################
! Check whether a parcel in cloud has moist static energy larger than environment's
!
!!$ xy_FlagCrossSatEquivPotTemp = .false.
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ do k = xy_IndexMixLayTop(i,j), l-1
!!$ if ( xyr_EnvMoistStaticEneSat(i,j,k) < xyr_CldMoistStaticEne(i,j,k) ) then
!!$ xy_FlagCrossSatEquivPotTemp(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!###############################################
! Cloud work function
!
! Auxiliary variables
!
z_Gamma = LatentHeat / CpDry * a_CalcDQVapSatDTemp( z_Temp, z_QH2OVapSat )
!
k = 1
z_Mu (k) = 1.0d100
z_Eps(k) = 1.0d100
do k = 2, kmax
z_Mu (k) = ( z_Exner(k ) - r_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
z_Eps(k) = ( r_Exner(k-1) - z_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
end do
!
! Cloud work function
!
CWF = 0.0_DP
do k = 2, l-1
if ( k > IndexMixLayTop ) then
CWF = CWF + z_Mu (k) * r_NormMassFlux(k ) * ( r_CldMoistStaticEne(k ) - z_EnvMoistStaticEneSat(k) ) + z_Eps(k) * r_NormMassFlux(k-1) * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
end if
end do
k = l
if ( k > IndexMixLayTop ) then
CWF = CWF + z_Eps(k) * r_NormMassFlux(k-1) * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
end if
! for save
z_CWF(l) = CWF
! Time derivative of cloud work function by large scale motion
!
DCWFDtLS = ( CWF - z_CWFCrtl(l) ) / ( 2.0_DP * DelTime )
! for save
z_DCWFDtLS(l) = DCWFDtLS
! Tendency of dry static energy per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaDSE(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_EnvDryStaticEne(k ) - z_EnvDryStaticEne(k+1) )
else
z_GammaDSE(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaDSE(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_EnvDryStaticEne(k-1) - z_EnvDryStaticEne(k) ) + r_NormMassFlux(k ) * ( z_EnvDryStaticEne(k ) - r_EnvDryStaticEne(k) ) )
end do
end if
k = l
z_GammaDSE(k) = z_GammaDSE(k) - Grav / z_DelPress(k) * LatentHeat * CldQH2OLiqCldTop * NormMassFluxCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) )
do k = l+1, kmax
z_GammaDSE(k) = 0.0_DP
end do
! Tendency of moist static energy per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaMSE(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_EnvMoistStaticEne(k ) - z_EnvMoistStaticEne(k+1) )
else
z_GammaMSE(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaMSE(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_EnvMoistStaticEne(k-1) - z_EnvMoistStaticEne(k) ) + r_NormMassFlux(k ) * ( z_EnvMoistStaticEne(k ) - r_EnvMoistStaticEne(k) ) )
end do
end if
k = l
z_GammaMSE(k) = z_GammaMSE(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( z_EnvMoistStaticEneSat(k) - z_EnvMoistStaticEne(k) )
do k = l+1, kmax
z_GammaMSE(k) = 0.0_DP
end do
! Kernel, time derivative of cloud work function by cumulus convection per unit
! mass flux
!
Kernel = z_Eps(IndexMixLayTop+1) * z_GammaMSE(IndexMixLayTop) - z_Eps(l) * r_NormMassFlux(l-1) * ( 1.0_DP + z_Gamma(l) ) * z_GammaDSE(l)
do n = IndexMixLayTop+1, l-1
SumTmp = 0.0_DP
do m = IndexMixLayTop+1, n
SumTmp = SumTmp + z_DelNormMassFlux(m) * z_GammaMSE(m)
end do
Kernel = Kernel + ( z_Eps(n+1) + z_Mu(n) ) * ( z_GammaMSE(IndexMixLayTop) - SumTmp ) - ( z_Eps(n) * r_NormMassFlux(n-1) + z_Mu (n) * r_NormMassFlux(n ) ) * ( 1.0_DP + z_Gamma(n) ) * z_GammaDSE(n)
end do
! Check whether kernel is positive or negative.
!
if ( Kernel < 0.0_DP ) then
FlagKernelNegative = .true.
else
FlagKernelNegative = .false.
end if
! Load et al. (1982), p.108
Kernel = min( Kernel, -5.0d-3 )
! Cloud mass flux at cloud bottom
!
CldMassFluxBottom = - DCWFDtLS / Kernel
!
! mass flux has to be zero or positive
CldMassFluxBottom = max( CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
end if
!!$ ! mass flux is zero if it is below lifting condensation level
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( .not. xy_FlagCrossSatEquivPotTemp(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end do
!!$ end do
! mass flux is zero if the LNB is unstable for updrafts
! (i.e., if the parcel is positively buoyant just above the LNB).
! See Lord et al. (1982), p.112, for more details.
! Strictly speaking, the process below is different from that
! proposed by Lord et al. (1982). Lord et al. (1982) compare
! entrainment parameters at 3 levels. But, entrainment
! parameters at 2 levels are compared below, because comparison
! of values between 2 levels seems to be sufficient.
!!$ if ( ( 3 <= l ) .and. ( l <= kmax-1 ) ) then
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end if
!!$ end do
!!$ end do
!!$ end if
!!$ if ( xy_IndexMixLayTop(i,j) == l ) then
!!$ if ( ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ if ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end if
!!$ else if ( ( xy_IndexMixLayTop(i,j) < l ) .and. ( l <= kmax-1 ) ) then
!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
if ( ( IndexMixLayTop <= l ) .and. ( l <= kmax-1 ) ) then
if ( ( EntParam > 0.0_DP ) .and. ( EntParamUL > 0.0_DP ) ) then
if ( EntParam < EntParamUL ) then
CldMassFluxBottom = 0.0_DP
end if
end if
end if
!
! mass flux is zero unless kernel is negative
!
if ( .not. FlagKernelNegative ) then
CldMassFluxBottom = 0.0_DP
end if
!
! mass flux is zero if liquid water at a cloud top is negative
!
if ( FlagNegH2OLiqCldTop ) then
CldMassFluxBottom = 0.0_DP
end if
!
! multiply factor
!
CldMassFluxBottom = CldMassFluxBottom * min( 2.0_DP * DelTime / AdjTimeConst, 1.0_DP )
!
! for output
z_MassFluxDistFunc(l) = CldMassFluxBottom
! Check values of cloud mass flux
! If water vapor amount transported by convection is larger than that in a
! column, cloud mass flux is reduced.
!
! tendency of specific humidity is calculated tentatively
do k = 1, kmax
z_DQVapDtCumulus(k) = + CldMassFluxBottom * ( z_GammaMSE(k) - z_GammaDSE(k) ) / LatentHeat
end do
! total H2O mass in a vertical column after RAS
z_QH2OVapTentative = z_QH2OVap + z_DQVapDtCumulus * 2.0_DP * DelTime
CldMassFluxCorFactor = 1.0_DP
do k = 1, kmax
if ( z_QH2OVapTentative(k) < 0.0_DP ) then
CldMassFluxCorFactorTentative = z_QH2OVap(k) / ( z_QH2OVap(k) - z_QH2OVapTentative(k) )
else
CldMassFluxCorFactorTentative = 1.0_DP
end if
if ( CldMassFluxCorFactorTentative < CldMassFluxCorFactor ) then
CldMassFluxCorFactor = CldMassFluxCorFactorTentative
end if
end do
! modify cloud mass flux
CldMassFluxBottom = CldMassFluxCorFactor * CldMassFluxBottom
!!$ do k = 1, kmax
!!$ xyz_DQVapDtCumulus(:,:,k) = &
!!$ & + xy_CloudMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) &
!!$ & / LatentHeat
!!$ end do
!!$ ! total H2O mass in a vertical column before RAS
!!$ xyz_DelH2OMass = xyz_QH2OVap * xyz_DelPress / Grav
!!$ xy_H2OMassB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassB = xy_H2OMassB + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! total H2O mass in a vertical column after RAS
!!$ xyz_QH2OVapTentative = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
!!$ xyz_DelH2OMass = xyz_QH2OVapTentative * xyz_DelPress / Grav
!!$ xy_H2OMassA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassA = xy_H2OMassA + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! modify cloud mass flux
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xy_H2OMassA(i,j) < 0.0_DP ) then
!!$ ! A safety factor ( 1.0_DP + 1.0d-5 ) is arbitrary.
!!$ xy_CloudMassFluxBottom(i,j) = xy_CloudMassFluxBottom(i,j) &
!!$ & * xy_H2OMassB(i,j) &
!!$ & / ( ( xy_H2OMassB(i,j) - xy_H2OMassA(i,j) ) * ( 1.0_DP + 1.0d-5 ) )
!!$ end if
!!$ end do
!!$ end do
! Tendencies of specific temperature and humidity
!
do k = 1, kmax
z_DTempDtCumulus(k) = + CldMassFluxBottom * z_GammaDSE(k) / CpDry
z_DQVapDtCumulus(k) = + CldMassFluxBottom * ( z_GammaMSE(k) - z_GammaDSE(k) ) / LatentHeat
end do
!!$ !
!!$ ! modification of tendency of temperature and water vapor in the mixed layer
!!$ !
!!$ if ( FlagUniformMixedLayer ) then
!!$ xy_SumTmp = 0.0_DP
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & + xyz_DTempDtCumulus(i,j,k) &
!!$ & * ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) )
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & / ( xyr_Press(i,j,0) - xyr_Press(i,j,xy_IndexMixLayTop(i,j)) )
!!$ end do
!!$ end do
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xyz_DTempDtCumulus(i,j,k) = xy_SumTmp(i,j)
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ !
!!$ xy_SumTmp = 0.0_DP
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & + xyz_DQVapDtCumulus(i,j,k) &
!!$ & * ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) )
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ xy_SumTmp(i,j) = xy_SumTmp(i,j) &
!!$ & / ( xyr_Press(i,j,0) - xyr_Press(i,j,xy_IndexMixLayTop(i,j)) )
!!$ end do
!!$ end do
!!$ do k = 1, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( k <= xy_IndexMixLayTop(i,j) ) then
!!$ xyz_DQVapDtCumulus(i,j,k) = xy_SumTmp(i,j)
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$ end if
! add tendencies to temperature and specific humidity
!
z_Temp = z_Temp + z_DTempDtCumulus * 2.0_DP * DelTime
z_QH2OVap = z_QH2OVap + z_DQVapDtCumulus * 2.0_DP * DelTime
! Precipitation rate at cloud top level
! unit is kg m-2 s-1
!
z_RainCumulus(l) = CldMassFluxBottom * z_DetCldWatCondFactor(l) * NormMassFluxCldTop * CldQH2OLiqCldTop
! mass fix
!
z_DelH2OMass = z_QH2OVap * z_DelPress / Grav
! total H2O mass in a vertical column
H2OMassB = 0.0_DP
do k = kmax, 1, -1
H2OMassB = H2OMassB + z_DelH2OMass(k)
end do
if ( H2OMassB < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
call MessageNotify( 'M', module_name, 'Mass of water vapor in a column is negative, %f.', d = (/H2OMassB/) )
end if
! negative mass is borrowed from above
do k = 1, kmax-1
if ( z_DelH2OMass(k) < 0.0_DP ) then
z_DelH2OMass(k+1) = z_DelH2OMass(k+1) + z_DelH2OMass(k)
z_DelH2OMass(k ) = 0.0_DP
end if
end do
k = kmax
if ( z_DelH2OMass(k) < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'Mass of water vapor in the top layer is negative (%d,%d,%d), %f.', &
!!$ & i = (/i,j,k/), d = (/xyz_DelH2OMass(i,j,k)/) )
!!$
!!$ xyz_RainCumulus(i,j,l) = xyz_RainCumulus(i,j,l) &
!!$ & - xyz_DelH2OMass(i,j,k) / ( 2.0_DP * DelTime )
!!$ xyz_Temp (i,j,k) = xyz_Temp(i,j,k) &
!!$ & - LatentHeat * xyz_DelH2OMass(i,j,k) / ( xyz_DelPress(i,j,k) / Grav )&
!!$ & / CpDry
z_DelH2OMass (k) = 0.0_DP
end if
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xyz_RainCumulus(i,j,l) < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'Mass of water vapor is insufficient at (%d,%d,%d), %f.', &
!!$ & i = (/i,j,k/), d = (/xyz_RainCumulus(i,j,l)/) )
!!$ end if
!!$ end do
!!$ end do
! total H2O mass in a vertical column, again
H2OMassA = 0.0_DP
do k = kmax, 1, -1
H2OMassA = H2OMassA + z_DelH2OMass(k)
end do
! total mass in a vertical column is adjusted
if ( H2OMassA > 0.0_DP ) then
!!$ write( 6, * ) i, j, xy_H2OMassB(i,j), xy_H2OMassB(i,j) / xy_H2OMassA(i,j)
do k = 1, kmax
z_DelH2OMass(k) = z_DelH2OMass(k) * H2OMassB / H2OMassA
end do
else
do k = 1, kmax
z_DelH2OMass(k) = 0.0_DP
end do
end if
z_QH2OVap = z_DelH2OMass / ( z_DelPress / Grav )
! Detrainment mass tendency per unit mass (kg m-3 s-1 / ( kg m-3 ) = s-1).
! This corresponds to condensation rate (kg m-2 s-1) divided by layer thickness (m)
! and density (kg m-3), in other words.
! kg m-2 s-1 / ( Pa / ( m s-2 ) )
! = kg m-2 s-1 Pa-1 m s-1 = kg m-2 (kg m s-2 m-2)-1 m s-2
! = kg m-2 s-1 kg-1 m-1 s2 m2 m s-2 = s-1
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(l) = CldMassFluxBottom * NormMassFluxCldTop / ( z_DelPress(l) / Grav )
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
do k = 1, l-1
if ( k > IndexMixLayTop ) then
DelNormMassFluxHalfLayer = - EntParam * z_BetaCldTop(k) * z_PotTemp(k)
NormMassFlux = r_NormMassFlux(k-1) - DelNormMassFluxHalfLayer
z_MoistConvSubsidMassFlux(k) = z_MoistConvSubsidMassFlux(k) + CldMassFluxBottom * NormMassFlux
end if
end do
end if
end do loop_cloud_top
! 温度変化率, 比湿変化率
! Calculate specific humidity tendency and temperature tendency
! (In fact, temperature tendency does not need to calculate, here.)
!
z_DTempDtCumulus = ( z_Temp - z_TempB ) / ( 2.0_DP * DelTime )
z_DQVapDtCumulus = ( z_QH2OVap - z_QH2OVapB ) / ( 2.0_DP * DelTime )
! Precipitation rate at the surface
! unit is kg m-2 s-1
!
!!$ xy_RainCumulus = 0.0d0
!!$ do k = kmax, 1, -1
!!$ xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
!!$ end do
z_DQH2OLiqDt = z_RainCumulus / ( z_DelPress / Grav )
!!$ xyz_RainCumulus = xyz_DQH2OLiqDt * ( xyz_DelPress / Grav )
!!$ xy_RainCumulus = 0.0d0
!!$ do k = kmax, 1, -1
!!$ xy_RainCumulus = xy_RainCumulus + xyz_RainCumulus(:,:,k)
!!$ end do
!!$
!!$ xy_Rain = xy_Rain + xy_RainCumulus
! Calculation for debug
! check of conservation of water amount and internal energy
!
!!$ xyz_DelVal = xyz_QH2OVapB * xyz_DelPress / Grav
!!$ xy_SumValB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_SumValB = xy_SumValB + xyz_DelVal(:,:,k)
!!$ end do
!!$ !
!!$ xyz_DelVal = xyz_QH2OVap * xyz_DelPress / Grav
!!$ xy_SumValA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_SumValA = xy_SumValA + xyz_DelVal(:,:,k)
!!$ end do
!!$ !
!!$ xy_SumValA = xy_SumValA + xy_RainCumulus * 2.0_DP * DelTime
!!$ !
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ Ratio = ( xy_SumValA(i,j) - xy_SumValB(i,j) ) &
!!$ & / max( xy_SumValA(i,j), 1.0d-100 )
!!$ if ( abs( Ratio ) > 1.0d-14 ) then
!!$ write( 6, * ) 'H2O: ', i, j, &
!!$ & xy_SumValB(i,j), xy_SumValA(i,j), &
!!$ & xy_RainCumulus(i,j) * 2.0_DP * DelTime, &
!!$ & Ratio
!!$ end if
!!$ end do
!!$ end do
!!$ !
!!$ !
!!$ xyz_DelVal = CpDry * xyz_TempB * xyz_DelPress / Grav
!!$ xy_SumValB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_SumValB = xy_SumValB + xyz_DelVal(:,:,k)
!!$ end do
!!$ !
!!$ xyz_DelVal = CpDry * xyz_Temp * xyz_DelPress / Grav
!!$ xy_SumValA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_SumValA = xy_SumValA + xyz_DelVal(:,:,k)
!!$ end do
!!$ !
!!$ xy_SumValA = xy_SumValA - LatentHeat * xy_RainCumulus * 2.0_DP * DelTime
!!$ !
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ Ratio = ( xy_SumValA(i,j) - xy_SumValB(i,j) ) &
!!$ & / max( xy_SumValA(i,j), 1.0d-100 )
!!$ if ( abs( Ratio ) > 1.0d-14 ) then
!!$ write( 6, * ) 'CpT: ', i, j, &
!!$ & xy_SumValB(i,j), xy_SumValA(i,j), &
!!$ & - LatentHeat * xy_RainCumulus(i,j) * 2.0_DP * DelTime, &
!!$ & Ratio
!!$ end if
!!$ end do
!!$ end do
! calculation for output
! This calculation is meaningless because RainCumulus is not used below.
z_RainCumulus = z_DQH2OLiqDt * ( z_DelPress / Grav )
RainCumulus = 0.0d0
do k = kmax, 1, -1
RainCumulus = RainCumulus + z_RainCumulus(k)
end do
!!$ if ( present( xyz_DQH2OLiqDt ) ) then
!!$
!!$ ! unit is kg m-2 s-1
!!$ xyz_DDelLWDtCCPLV = xyz_RainCumulus
!!$
!!$ ! 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_DDelLWDtCCPLV(i,j,k) = xyz_DDelLWDtCCPLV(i,j,k) + xy_NegDDelLWDt(i,j)
!!$ if ( xyz_DDelLWDtCCPLV(i,j,k) < 0.0d0 ) then
!!$ xy_NegDDelLWDt(i,j) = xyz_DDelLWDtCCPLV(i,j,k)
!!$ xyz_DDelLWDtCCPLV(i,j,k) = 0.0d0
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!!$
!!$ ! unit is s-1
!!$ xyz_DQH2OLiqDt = xyz_DDelLWDtCCPLV / ( xyz_DelPress / Grav )
!!$
!!$ end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RAS1D
| Subroutine : | |
| r_Press(0:kmax) : | real(DP), intent(in) |
| z_TempB(1:kmax) : | real(DP), intent(in) |
| z_QH2OVapB(1:kmax) : | real(DP), intent(in) |
| z_QH2OLiqB(1:kmax) : | real(DP), intent(in) |
| z_Temp(1:kmax) : | real(DP), intent(in) |
| z_QH2OVap(1:kmax) : | real(DP), intent(in) |
| z_QH2OLiq(1:kmax) : | real(DP), intent(in) |
subroutine RAS1DChkCons( r_Press, z_TempB, z_QH2OVapB, z_QH2OLiqB, z_Temp , z_QH2OVap , z_QH2OLiq )
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
real(DP), intent(in) :: r_Press (0:kmax)
real(DP), intent(in) :: z_TempB (1:kmax)
real(DP), intent(in) :: z_QH2OVapB(1:kmax)
real(DP), intent(in) :: z_QH2OLiqB(1:kmax)
real(DP), intent(in) :: z_Temp (1:kmax)
real(DP), intent(in) :: z_QH2OVap (1:kmax)
real(DP), intent(in) :: z_QH2OLiq (1:kmax)
! Local variables
!
real(DP) :: z_DelMass(1:kmax)
real(DP) :: Val
real(DP) :: SumB
real(DP) :: Sum
real(DP) :: Ratio
integer :: k
do k = 1, kmax
z_DelMass(k) = ( r_Press(k-1) - r_Press(k) ) / Grav
end do
Sum = 0.0_DP
do k = kmax, 1, -1
Val = CpDry * z_TempB(k) + LatentHeat * z_QH2OVapB(k)
Sum = Sum + Val * z_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = CpDry * z_Temp(k) + LatentHeat * z_QH2OVap(k)
Sum = Sum + Val * z_DelMass(k)
end do
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'Modified condensate static energy is not conserved, %f.', d = (/ Ratio /) )
end if
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_QH2OVapB(k) + z_QH2OLiqB(k)
Sum = Sum + Val * z_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_QH2OVap (k) + z_QH2OLiq (k)
Sum = Sum + Val * z_DelMass(k)
end do
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'H2O mass is not conserved, %f.', d = (/ Ratio /) )
end if
end subroutine RAS1DChkCons
| Subroutine : | |
| z_Temp(1:kmax) : | real(DP), intent(in ) |
| z_Exner(1:kmax) : | real(DP), intent(in ) |
| z_Beta(1:kmax) : | real(DP), intent(in ) |
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) |
| z_Height(1:kmax) : | real(DP), intent(out) |
| r_Height(0:kmax) : | real(DP), intent(out) |
高度の計算
Calculation of height
subroutine RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
!
! 高度の計算
!
! Calculation of height
!
! モジュール引用 ; USE statements
!
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: z_Temp (1:kmax)
real(DP), intent(in ) :: z_Exner (1:kmax)
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop(1:kmax)
real(DP), intent(out) :: z_Height (1:kmax)
real(DP), intent(out) :: r_Height (0:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_PotTemp(1:kmax)
!!$ character(STRING) :: VarName
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
z_PotTemp = z_Temp / z_Exner
r_Height(0) = 0.0_DP
do k = 1, kmax
z_Height(k) = r_Height(k-1) + z_BetaCldTop(k) * z_PotTemp(k)
r_Height(k) = r_Height(k-1) + z_Beta (k) * z_PotTemp(k)
end do
end subroutine RAS1DHeight
| Subroutine : | |
| xyr_Press(0:imax-1,1:jmax,0:kmax) : | real(DP), intent(in) |
| xyz_TempB(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
| xyz_QH2OVapB(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
| xyz_QH2OLiqB(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
| xyz_Temp(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
| xyz_QH2OVap(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
| xyz_QH2OLiq(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in) |
subroutine RASChkCons( xyr_Press, xyz_TempB, xyz_QH2OVapB, xyz_QH2OLiqB, xyz_Temp , xyz_QH2OVap , xyz_QH2OLiq )
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
real(DP), intent(in) :: xyr_Press (0:imax-1,1:jmax,0:kmax)
real(DP), intent(in) :: xyz_TempB (0:imax-1,1:jmax,1:kmax)
real(DP), intent(in) :: xyz_QH2OVapB(0:imax-1,1:jmax,1:kmax)
real(DP), intent(in) :: xyz_QH2OLiqB(0:imax-1,1:jmax,1:kmax)
real(DP), intent(in) :: xyz_Temp (0:imax-1,1:jmax,1:kmax)
real(DP), intent(in) :: xyz_QH2OVap (0:imax-1,1:jmax,1:kmax)
real(DP), intent(in) :: xyz_QH2OLiq (0:imax-1,1:jmax,1:kmax)
! Local variables
!
real(DP) :: xyz_DelMass(0:imax-1,1:jmax,1:kmax)
real(DP) :: xy_Val (0:imax-1,1:jmax)
real(DP) :: xy_SumB (0:imax-1,1:jmax)
real(DP) :: xy_Sum (0:imax-1,1:jmax)
real(DP) :: xy_Ratio(0:imax-1,1:jmax)
integer :: i
integer :: j
integer :: k
do k = 1, kmax
xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
end do
xy_Sum = 0.0_DP
do k = kmax, 1, -1
xy_Val = CpDry * xyz_TempB(:,:,k) + LatentHeat * xyz_QH2OVapB(:,:,k)
xy_Sum = xy_Sum + xy_Val * xyz_DelMass(:,:,k)
end do
xy_SumB = xy_Sum
xy_Sum = 0.0_DP
do k = kmax, 1, -1
xy_Val = CpDry * xyz_Temp(:,:,k) + LatentHeat * xyz_QH2OVap(:,:,k)
xy_Sum = xy_Sum + xy_Val * xyz_DelMass(:,:,k)
end do
xy_Ratio = ( xy_Sum - xy_SumB ) / ( xy_Sum + 1.0d-100 )
do j = 1, jmax
do i = 0, imax-1
if ( abs( xy_Ratio(i,j) ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'Modified condensate static energy is not conserved, %f.', d = (/ xy_Ratio(i,j) /) )
end if
end do
end do
xy_Sum = 0.0_DP
do k = kmax, 1, -1
xy_Val = xyz_QH2OVapB(:,:,k) + xyz_QH2OLiqB(:,:,k)
xy_Sum = xy_Sum + xy_Val * xyz_DelMass(:,:,k)
end do
xy_SumB = xy_Sum
xy_Sum = 0.0_DP
do k = kmax, 1, -1
xy_Val = xyz_QH2OVap (:,:,k) + xyz_QH2OLiq (:,:,k)
xy_Sum = xy_Sum + xy_Val * xyz_DelMass(:,:,k)
end do
xy_Ratio = ( xy_Sum - xy_SumB ) / ( xy_Sum + 1.0d-100 )
do j = 1, jmax
do i = 0, imax-1
if ( abs( xy_Ratio(i,j) ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'H2O mass is not conserved, %f.', d = (/ xy_Ratio(i,j) /) )
end if
end do
end do
end subroutine RASChkCons
| Subroutine : | |
| l : | integer , intent(in ) |
| xyz_Beta(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_BetaCldTop(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_PotTemp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_EnvMoistStaticEne(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xy_IndexMixLayTop(0:imax-1, 1:jmax) : | integer , intent(in ) |
| xy_EntParam(0:imax-1, 1:jmax) : | real(DP), intent(out) |
エントレインメントパラメータの計算
Calculation of entrainment parameter
subroutine RASEntParam( l, xyz_Beta, xyz_BetaCldTop, xyz_PotTemp, xyz_EnvMoistStaticEne, xyz_EnvMoistStaticEneSat, xy_IndexMixLayTop, xy_EntParam )
!
! エントレインメントパラメータの計算
!
! Calculation of entrainment parameter
!
! モジュール引用 ; USE statements
!
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: xyz_Beta (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_BetaCldTop (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_PotTemp (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_EnvMoistStaticEne (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_EnvMoistStaticEneSat(0:imax-1, 1:jmax, 1:kmax)
integer , intent(in ) :: xy_IndexMixLayTop (0:imax-1, 1:jmax)
real(DP), intent(out) :: xy_EntParam (0:imax-1, 1:jmax)
! 作業変数
! Work variables
!
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
! 実行文 ; Executable statement
!
! Entrainment parameter
!
xy_EntParam = 0.0_DP
do k = 2, l-1
do j = 1, jmax
do i = 0, imax-1
if ( k > xy_IndexMixLayTop(i,j) ) then
xy_EntParam(i,j) = xy_EntParam(i,j) + xyz_Beta(i,j,k) * xyz_PotTemp(i,j,k) * ( xyz_EnvMoistStaticEneSat(i,j,l) - xyz_EnvMoistStaticEne(i,j,k) )
end if
end do
end do
end do
do j = 1, jmax
do i = 0, imax-1
if ( l > xy_IndexMixLayTop(i,j) ) then
xy_EntParam(i,j) = xy_EntParam(i,j) + xyz_BetaCldTop(i,j,l) * xyz_PotTemp(i,j,l) * ( xyz_EnvMoistStaticEneSat(i,j,l) - xyz_EnvMoistStaticEne(i,j,l) )
xy_EntParam(i,j) = ( xyz_EnvMoistStaticEne(i,j,xy_IndexMixLayTop(i,j)) - xyz_EnvMoistStaticEneSat(i,j,l) ) / ( xy_EntParam(i,j) + 1.0d-100 )
end if
end do
end do
end subroutine RASEntParam
| Subroutine : | |
| l : | integer , intent(in ) |
| z_Beta(1:kmax) : | real(DP), intent(in ) |
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) |
| z_PotTemp(1:kmax) : | real(DP), intent(in ) |
| z_EnvMoistStaticEne(1:kmax) : | real(DP), intent(in ) |
| z_EnvMoistStaticEneSat(1:kmax) : | real(DP), intent(in ) |
| IndexMixLayTop : | integer , intent(in ) |
| EntParam : | real(DP), intent(out) |
エントレインメントパラメータの計算
Calculation of entrainment parameter
subroutine RASEntParam1D( l, z_Beta, z_BetaCldTop, z_PotTemp, z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, IndexMixLayTop, EntParam )
!
! エントレインメントパラメータの計算
!
! Calculation of entrainment parameter
!
! モジュール引用 ; USE statements
!
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop (1:kmax)
real(DP), intent(in ) :: z_PotTemp (1:kmax)
real(DP), intent(in ) :: z_EnvMoistStaticEne (1:kmax)
real(DP), intent(in ) :: z_EnvMoistStaticEneSat(1:kmax)
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(out) :: EntParam
! 作業変数
! Work variables
!
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
! Entrainment parameter
!
EntParam = 0.0_DP
do k = 2, l-1
if ( k > IndexMixLayTop ) then
EntParam = EntParam + z_Beta(k) * z_PotTemp(k) * ( z_EnvMoistStaticEneSat(l) - z_EnvMoistStaticEne(k) )
end if
end do
if ( l > IndexMixLayTop ) then
EntParam = EntParam + z_BetaCldTop(l) * z_PotTemp(l) * ( z_EnvMoistStaticEneSat(l) - z_EnvMoistStaticEne(l) )
EntParam = ( z_EnvMoistStaticEne(IndexMixLayTop) - z_EnvMoistStaticEneSat(l) ) / ( EntParam + 1.0d-100 )
end if
end subroutine RASEntParam1D
| Subroutine : | |
| xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_Exner(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_Beta(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_BetaCldTop(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_Height(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out) |
| xyr_Height(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out) |
高度の計算
Calculation of height
subroutine RASHeight( xyz_Temp, xyz_Exner, xyz_Beta, xyz_BetaCldTop, xyz_Height, xyr_Height )
!
! 高度の計算
!
! Calculation of height
!
! モジュール引用 ; USE statements
!
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_Exner (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_Beta (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_BetaCldTop(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out) :: xyz_Height (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out) :: xyr_Height (0:imax-1, 1:jmax, 0:kmax)
! 作業変数
! Work variables
!
real(DP) :: xyz_PotTemp(0:imax-1, 1:jmax, 1:kmax)
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
xyz_PotTemp = xyz_Temp / xyz_Exner
xyr_Height(:,:,0) = 0.0_DP
do k = 1, kmax
xyz_Height(:,:,k) = xyr_Height(:,:,k-1) + xyz_BetaCldTop(:,:,k) * xyz_PotTemp(:,:,k)
xyr_Height(:,:,k) = xyr_Height(:,:,k-1) + xyz_Beta (:,:,k) * xyz_PotTemp(:,:,k)
end do
end subroutine RASHeight
| Subroutine : | |||
| SurfTemp : | real(DP), intent(in )
| ||
| z_Press(1:kmax) : | real(DP), intent(in )
| ||
| r_Press(0:kmax) : | real(DP), intent(in )
| ||
| z_Exner(1:kmax) : | real(DP), intent(in )
| ||
| r_Exner(0:kmax) : | real(DP), intent(in )
| ||
| z_ArgTemp(1:kmax) : | real(DP), intent(in )
| ||
| z_ArgQH2OVap(1:kmax) : | real(DP), intent(in )
| ||
| z_ArgQH2OLiq(1:kmax) : | real(DP), intent(in )
| ||
| z_ArgQH2OSol(1:kmax) : | real(DP), intent(in )
| ||
| z_ArgU(1:kmax) : | real(DP), intent(in )
| ||
| z_ArgV(1:kmax) : | real(DP), intent(in )
| ||
| z_DTempDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DQH2OVapDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DQH2OLiqDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DQH2OSolDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DUDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DVDt(1:kmax) : | real(DP), intent(out ) | ||
| SurfRainFlux : | real(DP), intent(out )
| ||
| SurfSnowFlux : | real(DP), intent(out )
| ||
| z_MoistConvDetTend(1:kmax) : | real(DP), intent(out ), optional | ||
| z_MoistConvSubsidMassFlux(1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldTemp(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OVap(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OLiq(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OSol(0:kmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_ArgTemp, z_ArgQH2OVap, z_ArgQH2OLiq, z_ArgQH2OSol, z_ArgU, z_ArgV, z_DTempDt, z_DQH2OVapDt, z_DQH2OLiqDt, z_DQH2OSolDt, z_DUDt, z_DVDt, SurfRainFlux, SurfSnowFlux, z_MoistConvDetTend, z_MoistConvSubsidMassFlux, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: SurfTemp
! Pressure
real(DP), intent(in ) :: z_Press (1:kmax)
! Pressure
real(DP), intent(in ) :: r_Press (0:kmax)
! Pressure
real(DP), intent(in ) :: z_Exner (1:kmax)
! Exner function
real(DP), intent(in ) :: r_Exner (0:kmax)
! Exner function
real(DP), intent(in ) :: z_ArgTemp (1:kmax)
! Temperature
real(DP), intent(in ) :: z_ArgQH2OVap(1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(in ) :: z_ArgQH2OLiq(1:kmax)
! Specific liquid water content
real(DP), intent(in ) :: z_ArgQH2OSol(1:kmax)
! Specific ice content
real(DP), intent(in ) :: z_ArgU (1:kmax)
! Zonal wind
real(DP), intent(in ) :: z_ArgV (1:kmax)
! Meridional wind
real(DP), intent(out ) :: z_DTempDt (1:kmax)
real(DP), intent(out ) :: z_DQH2OVapDt(1:kmax)
real(DP), intent(out ) :: z_DQH2OLiqDt(1:kmax)
real(DP), intent(out ) :: z_DQH2OSolDt(1:kmax)
real(DP), intent(out ) :: z_DUDt (1:kmax)
real(DP), intent(out ) :: z_DVDt (1:kmax)
real(DP), intent(out ) :: SurfRainFlux
! 降水量.
! Precipitation
real(DP), intent(out ) :: SurfSnowFlux
! 降雪量.
! Snow
real(DP), intent(out ), optional :: z_MoistConvDetTend (1:kmax)
real(DP), intent(out ), optional :: z_MoistConvSubsidMassFlux(1:kmax)
real(DP), intent(out ), optional :: rz_CldTemp (0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OVap(0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OLiq(0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OSol(0:kmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_Temp (1:kmax)
! Temperature
real(DP) :: z_QH2OVap(1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP) :: z_QH2OLiq(1:kmax)
! Specific liquid water content
real(DP) :: z_QH2OSol(1:kmax)
! Specific ice content
real(DP) :: z_U (1:kmax)
! Zonal wind
real(DP) :: z_V (1:kmax)
! Meridional wind
real(DP) :: z_Height (1:kmax)
!
! Height
real(DP) :: r_Height (0:kmax)
!
! Height
real(DP) :: z_DTempDtCumulus (1:kmax)
! 温度変化率.
! Temperature tendency
real(DP) :: z_DQVapDtCumulus (1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP) :: z_PotTemp (1:kmax)
! Potential temperature
!
!!$ real(DP) :: z_QH2OVapSat(1:kmax)
!!$ ! 飽和比湿.
!!$ ! Saturation specific humidity.
!!$ ! Dry and moist static energy in environment (Env) and cloud (Cld)
!!$ !
!!$ real(DP) :: z_EnvDryStaticEne (1:kmax)
!!$ real(DP) :: r_EnvDryStaticEne (0:kmax)
!!$ real(DP) :: z_EnvMoistStaticEne (1:kmax)
!!$ real(DP) :: r_EnvMoistStaticEne (0:kmax)
!!$ real(DP) :: z_EnvMoistStaticEneSat(1:kmax)
!!$ real(DP) :: r_EnvMoistStaticEneSat(0:kmax)
!!$
!!$ real(DP) :: z_EnvCondStaticEne (1:kmax)
!!$
!!$ real(DP) :: r_CldMoistStaticEne (0:kmax)
!!$ real(DP) :: r_CldCondStaticEne (0:kmax)
!!$
!!$ real(DP) :: CldCondStaticEneCldTop
real(DP) :: Kernel
! Tendency of cloud work function by cumulus convection, kernel
real(DP) :: CWF
! Cloud work function
real(DP) :: z_CWF(1:kmax)
! Cloud work function
! (variable for output)
real(DP) :: DCWFDtLS
! Tendency of cloud work function by large scale motion
real(DP) :: z_DCWFDtLS(1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
real(DP) :: CldMassFluxBottom
! Cloud mass flux at cloud bottom
real(DP) :: z_Beta (1:kmax)
real(DP) :: z_BetaCldTop (1:kmax)
real(DP) :: z_Gamma (1:kmax)
real(DP) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
!!$ real(DP) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP) :: z_GammaQH2OVap (1:kmax)
! Tendency of water vapor per unit mass flux
real(DP) :: z_GammaQH2OLiq (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP) :: z_GammaQH2OSol (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP) :: z_GammaQRain (1:kmax)
! Tendency of rain per unit mass flux
real(DP) :: z_GammaQSnow (1:kmax)
! Tendency of snow per unit mass flux
real(DP) :: z_GammaU (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP) :: z_GammaV (1:kmax)
! Tendency of meridional wind per unit mass flux
!!$ real(DP) :: zf_GammaQOthers (1:kmax,1:ncmax)
!!$ ! Tendency of passive constituents per unit mass flux
real(DP) :: z_Mu (1:kmax)
real(DP) :: z_Eps (1:kmax)
real(DP) :: PressCldBase
! Pressure of cloud base
real(DP) :: z_CWFCrtl (1:kmax)
! "Critical value" of cloud work function
real(DP) :: z_DetCldWatCondFactor (1:kmax)
real(DP) :: z_DetCldIceCondFactor (1:kmax)
real(DP) :: EntParam
! Entrainment factor
real(DP) :: z_EntParam (1:kmax)
! Entrainment factor (variable for output)
!!$ real(DP) :: EntParamLL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! higher level
!!$ real(DP) :: EntParamUL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! lower level
! Difference of normalized mass flux between layer interface
real(DP) :: z_DelNormMassFlux (1:kmax)
real(DP) :: DelNormMassFluxCldTop
! Normalized mass flux at layer interface and cloud top
real(DP) :: r_NormMassFlux (0:kmax)
real(DP) :: NormMassFluxCldTop
!!$ ! cloud total water
!!$ real(DP) :: r_CldQH2OTot(0:kmax)
!!$ ! cloud total water at cloud top
!!$ real(DP) :: CldQH2OTotCldTop
!!$ ! cloud condensate at cloud top
!!$ real(DP) :: CldQH2OCondCldTop
! cloud water at cloud top
real(DP) :: CldQH2OLiqCldTop
! cloud ice at cloud top
real(DP) :: CldQH2OSolCldTop
! Mass flux distribution function
real(DP) :: z_MassFluxDistFunc (1:kmax)
!!$ real(DP) :: z_DelH2OMass (1:kmax)
!!$ real(DP) :: H2OMassB
!!$ real(DP) :: H2OMassA
!!$ real(DP) :: NegDDelLWDt
!!$ real(DP) :: z_DDelLWDtCCPLV(1:kmax)
!!$ logical :: FlagCrossSatEquivPotTemp
!!$ !
!!$ ! Flag showing whether a parcel in cloud has moist static
!!$ ! energy larger than environment's
real(DP) :: r_QH2OVapSat (0:kmax)
real(DP) :: r_TempAdiabAscent (0:kmax)
real(DP) :: SurfPotTemp
!!$ real(DP) :: xyz_TempAdiabAscent (0:imax-1, 1:jmax, 1:kmax)
! Variables for looking for top of mixed layer
! IndexMixLayTop : r level index of a non-saturated uppermost level
!
logical :: FlagMixLayTopFound
integer :: IndexMixLayTop
! Variables for modification of cloud mass flux
!
!!$ real(DP) :: z_QH2OVapTentative (1:kmax)
!!$ real(DP) :: CldMassFluxCorFactor
!!$ real(DP) :: CldMassFluxCorFactorTentative
real(DP) :: z_TempB (1:kmax)
! 調節前の温度.
! Temperature before adjustment
real(DP) :: z_QH2OVapB(1:kmax)
! 調節前の比湿.
! Specific humidity before adjustment
real(DP) :: z_QH2OLiqB(1:kmax)
!
! Specific liquid water content before adjustment
real(DP) :: z_QH2OSolB(1:kmax)
!
! Specific liquid water content before adjustment
real(DP) :: z_UB (1:kmax)
!
! Zonal wind before adjustment
real(DP) :: z_VB (1:kmax)
!
! Meridional wind before adjustment
! Flags for modification of
!
logical :: FlagKernelNegative
logical :: FlagNegH2OCondCldTop
! Variables for subsidence mass flux between updrafts
!
real(DP) :: DelNormMassFluxHalfLayer
real(DP) :: NormMassFlux
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
!!$ real(DP) :: CldTempB
!!$ real(DP) :: a_DQVapSatDTemp(1:1)
!!$ real(DP) :: DelTemp
real(DP) :: r_CldTemp (0:kmax)
real(DP) :: r_CldQH2OVap(0:kmax)
real(DP) :: r_CldQH2OLiq(0:kmax)
real(DP) :: r_CldQH2OSol(0:kmax)
!!$ real(DP) :: r_CldHeight (0:kmax)
real(DP) :: SumTmp
real(DP) :: z_TempTMP (1:kmax)
real(DP) :: z_QH2OVapTMP(1:kmax)
real(DP) :: z_QH2OLiqTMP(1:kmax)
real(DP) :: z_QH2OSolTMP(1:kmax)
real(DP) :: z_UTMP(1:kmax)
real(DP) :: z_VTMP(1:kmax)
real(DP) :: z_DQRainDtTMP(1:kmax)
real(DP) :: z_DQSnowDtTMP(1:kmax)
real(DP) :: z_PotTempTMP(1:kmax)
real(DP) :: z_DelNormMassFluxTMP(1:kmax)
real(DP) :: DelNormMassFluxCldTopTMP
real(DP) :: r_NormMassFluxTMP(0:kmax)
real(DP) :: NormMassFluxCldTopTMP
real(DP) :: CldQH2OLiqCldTopTMP
real(DP) :: CldQH2OSolCldTopTMP
real(DP) :: CWFTMP
real(DP) :: EntParamTMP
real(DP) :: z_MuTMP(1:kmax)
real(DP) :: z_EpsTMP(1:kmax)
real(DP) :: z_GammaTMP(1:kmax)
real(DP) :: z_GammaDSETMP(1:kmax)
!!$ real(DP) :: z_GammaMSETMP(1:kmax)
real(DP) :: z_GammaQH2OVapTMP(1:kmax)
real(DP) :: z_GammaQH2OLiqTMP(1:kmax)
real(DP) :: z_GammaQH2OSolTMP(1:kmax)
real(DP) :: z_GammaQRainTMP (1:kmax)
real(DP) :: z_GammaQSnowTMP (1:kmax)
real(DP) :: z_GammaUTMP (1:kmax)
real(DP) :: z_GammaVTMP (1:kmax)
!!$ real(DP) :: zf_GammaQOthersTMP(1:kmax,1:ncmax)
logical :: FlagEntParamOrderInapp
logical :: FlagEntParamOrderInappTMP
logical :: FlagNegH2OCondCldTopTMP
real(DP) :: rz_CldTempTMP (0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OVapTMP(0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OLiqTMP(0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OSolTMP(0:kmax, 1:kmax)
real(DP) :: z_DQRainDt (1:kmax)
real(DP) :: z_DQSnowDt (1:kmax)
real(DP) :: HeightMixLayTop
! Mixed layer top height
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer :: l
!!$ integer :: m
!!$ integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
z_Temp = z_ArgTemp
z_QH2OVap = z_ArgQH2OVap
z_QH2OLiq = z_ArgQH2OLiq
z_QH2OSol = z_ArgQH2OSol
z_U = z_ArgU
z_V = z_ArgV
! 調節前 "Temp", "QH2OVap" の保存
! Store "Temp", "QH2OVap" before adjustment
!
z_TempB = z_Temp
z_QH2OVapB = z_QH2OVap
z_QH2OLiqB = z_QH2OLiq
z_QH2OSolB = z_QH2OSol
z_UB = z_U
z_VB = z_V
! Preparation of variables
!
!
! Auxiliary variables
! Pressure difference between upper and lower interface of the layer
do k = 1, kmax
z_DelPress(k) = r_Press(k-1) - r_Press(k)
end do
! beta
do k = 1, kmax
z_Beta(k) = CpDry / Grav * ( r_Exner(k-1) - r_Exner(k) )
end do
do k = 1, kmax
z_BetaCldTop(k) = CpDry / Grav * ( r_Exner(k-1) - z_Exner(k) )
end do
!
! Search for top of mixed layer (lifting condensation level) based on
! a description in p.684 of Arakawa and Shubert (1974).
!
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
!
!====================================
!
!!$ xyz_TempAdiabAscent(:,:,1) = xyz_Temp(:,:,1)
!!$ do k = 2, kmax
!!$ xyz_TempAdiabAscent(:,:,k) = &
!!$ & xyz_Temp(:,:,1) - Grav / CpDry * ( xyz_Height(:,:,k) - xyz_Height(:,:,1) )
!!$ end do
!!$ xyz_TempAdiabAscent = max( xyz_TempAdiabAscent, 1.0_DP )
!!$ xyz_QH2OVapSat = xyz_CalcQVapSat( xyz_TempAdiabAscent, xyz_Press )
!!$ xy_IndexMixLayTop = 1
!!$ xy_FlagMixLayTopFound = .false.
!!$ do k = 2, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xyz_QH2OVap(i,j,1) >= xyz_QH2OVapSat(i,j,k) ) .and. &
!!$ & ( .not. xy_FlagMixLayTopFound(i,j) ) ) then
!!$ xy_IndexMixLayTop (i,j) = k - 1
!!$ xy_FlagMixLayTopFound(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!
!------------------------------------
!
!!$ xyr_TempAdiabAscent(:,:,0) = xy_SurfTemp
!!$ do k = 1, kmax
!!$ xyr_TempAdiabAscent(:,:,k) = &
!!$ & xy_SurfTemp - Grav / CpDry * ( xyr_Height(:,:,k) - 0.0_DP )
!!$ end do
!!$ xyr_TempAdiabAscent = max( xyr_TempAdiabAscent, 1.0_DP )
!!$
r_TempAdiabAscent(0) = SurfTemp
SurfPotTemp = SurfTemp / r_Exner(0)
do k = 1, kmax
r_TempAdiabAscent(k) = SurfPotTemp * r_Exner(k)
end do
!
r_QH2OVapSat(0 ) = 1.0d100
r_QH2OVapSat(1:kmax-1) = a_CalcQVapSat( r_TempAdiabAscent(1:kmax-1), r_Press(1:kmax-1) )
r_QH2OVapSat(kmax ) = r_QH2OVapSat(kmax-1)
!
! IndexMixLayTop : r level index of a non-saturated uppermost level
IndexMixLayTop = 1
FlagMixLayTopFound = .false.
do k = 2, kmax
if ( ( z_QH2OVap(1) >= r_QH2OVapSat(k) ) .and. ( .not. FlagMixLayTopFound ) ) then
IndexMixLayTop = k - 1
FlagMixLayTopFound = .true.
end if
end do
!
!====================================
!
if ( .not. FlagMixLayTopFound ) then
IndexMixLayTop = kmax - 1
end if
!
if ( r_QH2OVapSat(IndexMixLayTop+1) == r_QH2OVapSat(IndexMixLayTop) ) then
HeightMixLayTop = r_Height(IndexMixLayTop)
else
HeightMixLayTop = ( r_Height (IndexMixLayTop+1) - r_Height (IndexMixLayTop) ) / ( r_QH2OVapSat(IndexMixLayTop+1) - r_QH2OVapSat(IndexMixLayTop) ) * ( z_QH2OVap(1) - r_QH2OVapSat(IndexMixLayTop) ) + r_Height(IndexMixLayTop)
end if
!
! Critical cloud work function
!
if ( FlagZeroCrtlCWF ) then
z_CWFCrtl = 0.0_DP
else
PressCldBase = r_Press(IndexMixLayTop)
call ASL1982CalcCWFCrtl1D( PressCldBase, z_Press, z_CWFCrtl )
end if
!
! Rain conversion factor
!
if ( DetCldWatCondFactor0 < 0.0_DP ) then
do k = 1, kmax
if ( z_Press(k) < 500.0d2 ) then
z_DetCldWatCondFactor(k) = 1.0_DP
else if ( z_Press(k) < 800.0d2 ) then
z_DetCldWatCondFactor(k) = 0.8_DP + ( 800.0d2 - z_Press(k) ) / 1500.0d2
else
z_DetCldWatCondFactor(k) = 0.8_DP
end if
end do
else
z_DetCldWatCondFactor = DetCldWatCondFactor0
end if
!
! Snow/Ice conversion factor
!
if ( DetCldIceCondFactor0 < 0.0_DP ) then
do k = 1, kmax
if ( z_Press(k) < 500.0d2 ) then
z_DetCldIceCondFactor(k) = 1.0_DP
else if ( z_Press(k) < 800.0d2 ) then
z_DetCldIceCondFactor(k) = 0.8_DP + ( 800.0d2 - z_Press(k) ) / 1500.0d2
else
z_DetCldIceCondFactor(k) = 0.8_DP
end if
end do
else
z_DetCldIceCondFactor = DetCldIceCondFactor0
end if
z_EntParam (1) = 0.0_DP
z_CWF (1) = 0.0_DP
z_DCWFDtLS (1) = 0.0_DP
z_MassFluxDistFunc(1) = 0.0_DP
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(1) = 0.0_DP
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
! Initialization
!
z_MoistConvSubsidMassFlux = 0.0_DP
end if
r_CldTemp = 1.0d100
r_CldQH2OVap = 1.0d100
r_CldQH2OLiq = 1.0d100
r_CldQH2OSol = 1.0d100
l = 1
if ( present( rz_CldTemp ) ) rz_CldTemp (:,l) = r_CldTemp
if ( present( rz_CldQH2OVap ) ) rz_CldQH2OVap(:,l) = r_CldQH2OVap
if ( present( rz_CldQH2OLiq ) ) rz_CldQH2OLiq(:,l) = r_CldQH2OLiq
if ( present( rz_CldQH2OSol ) ) rz_CldQH2OSol(:,l) = r_CldQH2OSol
z_DQRainDt(l) = 0.0_DP
z_DQSnowDt(l) = 0.0_DP
loop_cloud_top : do l = 2, kmax
call RASWithIce1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTemp, z_DelNormMassFlux, DelNormMassFluxCldTop, r_NormMassFlux, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, CWF, EntParam, z_Mu, z_Eps, z_Gamma, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, FlagEntParamOrderInapp, FlagNegH2OCondCldTop, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
! Time derivative of cloud work function by large scale motion
!
DCWFDtLS = ( CWF - z_CWFCrtl(l) ) / ( 2.0_DP * DelTime )
! for output
z_EntParam(l) = EntParam
! for save
z_CWF(l) = CWF
! for save
z_DCWFDtLS(l) = DCWFDtLS
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQRainDt(l), z_DQSnowDt(l) )
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(l) = 0.0_DP
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
do k = 1, l-1
if ( k > IndexMixLayTop ) then
z_MoistConvSubsidMassFlux(k) = 0.0_DP
end if
end do
end if
else
!-------------------------------------------------
! Calculation of kernel, tendency of cloud work function by cumulus
! convection per unit mass flux
!
! arbitrary small value is set for trial
!!$ CldMassFluxBottom = 1.0d0
! This value is empirically determined. Pressure dependence is
! introduced simply for future use.
!!$ CldMassFluxBottom = 1.0d-1 * r_Press(IndexMixLayTop) / 1.0d5
CldMassFluxBottom = 1.0d-3 * r_Press(IndexMixLayTop) / 1.0d5
! mass flux is zero if entrainment order is inappropriate
if ( FlagEntParamOrderInapp ) then
CldMassFluxBottom = 0.0_DP
end if
! mass flux is zero if liquid water at a cloud top is negative
if ( FlagNegH2OCondCldTop ) then
CldMassFluxBottom = 0.0_DP
end if
! mass flux has to be zero or positive
CldMassFluxBottom = max( CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
end if
! supress convection based on a method of Tokioka et al. (1988)
if ( EntParam < RASSupressFactor / HeightMixLayTop ) then
CldMassFluxBottom = 0.0_DP
end if
! modify cloud mass flux
call RASWithIce1DModMassFlux( z_QH2OVap, z_GammaQH2OVap, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OLiq, z_GammaQH2OLiq, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OSol, z_GammaQH2OSol, CldMassFluxBottom )
! update field by cumulus convection
z_TempTMP = z_Temp
z_QH2OVapTMP = z_QH2OVap
z_QH2OLiqTMP = z_QH2OLiq
z_QH2OSolTMP = z_QH2OSol
z_UTMP = z_U
z_VTMP = z_V
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_TempTMP, z_QH2OVapTMP, z_QH2OLiqTMP, z_QH2OSolTMP, z_UTMP, z_VTMP, z_DQRainDtTMP(l), z_DQSnowDtTMP(l) )
! calculation of cloud work function in a updated field
call RASWithIce1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_TempTMP, z_QH2OVapTMP, z_QH2OLiqTMP, z_QH2OSolTMP, z_UTMP, z_VTMP, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTempTMP, z_DelNormMassFluxTMP, DelNormMassFluxCldTopTMP, r_NormMassFluxTMP, NormMassFluxCldTopTMP, CldQH2OLiqCldTopTMP, CldQH2OSolCldTopTMP, CWFTMP, EntParamTMP, z_MuTMP, z_EpsTMP, z_GammaTMP, z_GammaDSETMP, z_GammaQH2OVapTMP, z_GammaQH2OLiqTMP, z_GammaQH2OSolTMP, z_GammaQRainTMP(l), z_GammaQSnowTMP(l), z_GammaUTMP, z_GammaVTMP, FlagEntParamOrderInappTMP, FlagNegH2OCondCldTopTMP, rz_CldTempTMP, rz_CldQH2OVapTMP, rz_CldQH2OLiqTMP, rz_CldQH2OSolTMP )
! calculation of kernel
Kernel = ( CWFTMP - CWF ) / ( 2.0_DP * DelTime ) / ( CldMassFluxBottom + 1.0d-100 )
!-------------------------------------------------
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ ! TEST RUN BY THE USE OF RAS METHOD FOR KERNEL CALCULATION
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$
!!$ z_GammaMSE = z_GammaDSE + LatentHeat * z_GammaQH2OVap
!!$
!!$ ! This is a method by RAS.
!!$ !
!!$ ! Kernel, time derivative of cloud work function by cumulus convection
!!$ ! per unit mass flux
!!$ !
!!$ Kernel = &
!!$ & z_Eps(IndexMixLayTop+1) &
!!$ & * z_GammaMSE(IndexMixLayTop) &
!!$ & - z_Eps(l) * r_NormMassFlux(l-1) &
!!$ & * ( 1.0_DP + z_Gamma(l) ) &
!!$ & * z_GammaDSE(l)
!!$ do n = IndexMixLayTop+1, l-1
!!$ SumTmp = 0.0_DP
!!$ do m = IndexMixLayTop+1, n
!!$ SumTmp = SumTmp &
!!$ & + z_DelNormMassFlux(m) * z_GammaMSE(m)
!!$ end do
!!$ Kernel = Kernel &
!!$ & + ( z_Eps(n+1) + z_Mu(n) ) &
!!$ & * ( z_GammaMSE(IndexMixLayTop) - SumTmp ) &
!!$ & - ( z_Eps(n) * r_NormMassFlux(n-1) &
!!$ & + z_Mu (n) * r_NormMassFlux(n ) ) &
!!$ & * ( 1.0_DP + z_Gamma(n) ) * z_GammaDSE(n)
!!$ end do
!!$
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
! Check whether kernel is positive or negative.
!
if ( Kernel < 0.0_DP ) then
FlagKernelNegative = .true.
else
FlagKernelNegative = .false.
end if
! Load et al. (1982), p.108
Kernel = min( Kernel, -5.0d-3 )
! Cloud mass flux at cloud bottom
!
CldMassFluxBottom = - DCWFDtLS / Kernel
!
! mass flux has to be zero or positive
CldMassFluxBottom = max( CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
end if
!!$ ! mass flux is zero if it is below lifting condensation level
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( .not. xy_FlagCrossSatEquivPotTemp(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end do
!!$ end do
! mass flux is zero if the LNB is unstable for updrafts
! (i.e., if the parcel is positively buoyant just above the LNB).
! See Lord et al. (1982), p.112, for more details.
! Strictly speaking, the process below is different from that
! proposed by Lord et al. (1982). Lord et al. (1982) compare
! entrainment parameters at 3 levels. But, entrainment
! parameters at 2 levels are compared below, because comparison
! of values between 2 levels seems to be sufficient.
!!!$ if ( ( 3 <= l ) .and. ( l <= kmax-1 ) ) then
!!!$ do j = 1, jmax
!!!$ do i = 0, imax-1
!!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!!$ end if
!!!$ end if
!!!$ end do
!!!$ end do
!!!$ end if
!!!$ if ( xy_IndexMixLayTop(i,j) == l ) then
!!!$ if ( ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ if ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) then
!!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!!$ end if
!!!$ end if
!!!$ else if ( ( xy_IndexMixLayTop(i,j) < l ) .and. ( l <= kmax-1 ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!
! This was used in a version without ice.
! But, now, lines below are commented out, because EntParamUL is not
! set. (2014/02/02)
! This is done below by the use of FlagEntParamOrderInapp.
!
!!$ if ( ( IndexMixLayTop <= l ) .and. ( l <= kmax-1 ) ) then
!!$ if ( ( EntParam > 0.0_DP ) .and. &
!!$ & ( EntParamUL > 0.0_DP ) ) then
!!$ if ( EntParam < EntParamUL ) then
!!$ CldMassFluxBottom = 0.0_DP
!!$ end if
!!$ end if
!!$ end if
!
! mass flux is zero if entrainment order is inappropriate
!
if ( FlagEntParamOrderInapp ) then
CldMassFluxBottom = 0.0_DP
end if
!
! mass flux is zero unless kernel is negative
!
if ( .not. FlagKernelNegative ) then
CldMassFluxBottom = 0.0_DP
end if
!
! mass flux is zero if liquid water at a cloud top is negative
!
if ( FlagNegH2OCondCldTop ) then
CldMassFluxBottom = 0.0_DP
end if
!
! multiply factor
!
CldMassFluxBottom = CldMassFluxBottom * min( 2.0_DP * DelTime / AdjTimeConst, 1.0_DP )
!
! for output
z_MassFluxDistFunc(l) = CldMassFluxBottom
! Check values of cloud mass flux
! If water vapor amount transported by convection is larger than that in a
! column, cloud mass flux is reduced.
!
! tendency of specific humidity is calculated tentatively
!!$ z_DQVapDtCumulus = &
!!$ & + CldMassFluxBottom * ( z_GammaMSE - z_GammaDSE ) &
!!$ & / LatentHeat
!!$ ! total H2O mass in a vertical column after RAS
!!$ z_QH2OVapTentative = z_QH2OVap + z_DQVapDtCumulus * 2.0_DP * DelTime
!!$ CldMassFluxCorFactor = 1.0_DP
!!$ do k = 1, kmax
!!$ if ( z_QH2OVapTentative(k) < 0.0_DP ) then
!!$ CldMassFluxCorFactorTentative = z_QH2OVap(k) &
!!$ & / ( z_QH2OVap(k) - z_QH2OVapTentative(k) )
!!$ else
!!$ CldMassFluxCorFactorTentative = 1.0_DP
!!$ end if
!!$ if ( CldMassFluxCorFactorTentative < CldMassFluxCorFactor ) then
!!$ CldMassFluxCorFactor = CldMassFluxCorFactorTentative
!!$ end if
!!$ end do
!!$ ! modify cloud mass flux
!!$ CldMassFluxBottom = CldMassFluxCorFactor * CldMassFluxBottom
call RASWithIce1DModMassFlux( z_QH2OVap, z_GammaQH2OVap, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OLiq, z_GammaQH2OLiq, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OSol, z_GammaQH2OSol, CldMassFluxBottom )
!!$ do k = 1, kmax
!!$ xyz_DQVapDtCumulus(:,:,k) = &
!!$ & + xy_CloudMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) &
!!$ & / LatentHeat
!!$ end do
!!$ ! total H2O mass in a vertical column before RAS
!!$ xyz_DelH2OMass = xyz_QH2OVap * xyz_DelPress / Grav
!!$ xy_H2OMassB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassB = xy_H2OMassB + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! total H2O mass in a vertical column after RAS
!!$ xyz_QH2OVapTentative = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
!!$ xyz_DelH2OMass = xyz_QH2OVapTentative * xyz_DelPress / Grav
!!$ xy_H2OMassA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassA = xy_H2OMassA + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! modify cloud mass flux
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xy_H2OMassA(i,j) < 0.0_DP ) then
!!$ ! A safety factor ( 1.0_DP + 1.0d-5 ) is arbitrary.
!!$ xy_CloudMassFluxBottom(i,j) = xy_CloudMassFluxBottom(i,j) &
!!$ & * xy_H2OMassB(i,j) &
!!$ & / ( ( xy_H2OMassB(i,j) - xy_H2OMassA(i,j) ) * ( 1.0_DP + 1.0d-5 ) )
!!$ end if
!!$ end do
!!$ end do
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQRainDt(l), z_DQSnowDt(l) )
! Detrainment mass tendency per unit mass (kg m-3 s-1 / ( kg m-3 ) = s-1).
! This corresponds to condensation rate (kg m-2 s-1) divided by layer thickness (m)
! and density (kg m-3), in other words.
! kg m-2 s-1 / ( Pa / ( m s-2 ) )
! = kg m-2 s-1 Pa-1 m s-1 = kg m-2 (kg m s-2 m-2)-1 m s-2
! = kg m-2 s-1 kg-1 m-1 s2 m2 m s-2 = s-1
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(l) = CldMassFluxBottom * NormMassFluxCldTop / ( z_DelPress(l) / Grav )
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
do k = 1, l-1
if ( k > IndexMixLayTop ) then
DelNormMassFluxHalfLayer = - EntParam * z_BetaCldTop(k) * z_PotTemp(k)
NormMassFlux = r_NormMassFlux(k-1) - DelNormMassFluxHalfLayer
z_MoistConvSubsidMassFlux(k) = z_MoistConvSubsidMassFlux(k) + CldMassFluxBottom * NormMassFlux
end if
end do
end if
end if
end do loop_cloud_top
! Cumulus precipitation
call RASWithIceCalcPRCPStepPC1D( IndexMixLayTop, r_Press, z_Press, z_DQRainDt, z_DQSnowDt, z_Temp, z_QH2OVap, SurfRainFlux, SurfSnowFlux )
! 温度変化率, 比湿変化率
! Calculate specific humidity tendency and temperature tendency
! (In fact, temperature tendency does not need to calculate, here.)
!
z_DTempDtCumulus = ( z_Temp - z_TempB ) / ( 2.0_DP * DelTime )
z_DQVapDtCumulus = ( z_QH2OVap - z_QH2OVapB ) / ( 2.0_DP * DelTime )
z_DQH2OLiqDt = ( z_QH2OLiq - z_QH2OLiqB ) / ( 2.0_DP * DelTime )
z_DQH2OSolDt = ( z_QH2OSol - z_QH2OSolB ) / ( 2.0_DP * DelTime )
! Check conservation
call RASWithIce1DChkCons( r_Press, z_TempB, z_QH2OVapB, z_QH2OLiqB, z_QH2OSolB, z_UB, z_VB, z_Temp , z_QH2OVap , z_QH2OLiq , z_QH2OSol, SurfRainFlux, SurfSnowFlux, z_U , z_V )
z_DTempDt = ( z_Temp - z_ArgTemp ) / ( 2.0_DP * DelTime )
z_DQH2OVapDt = ( z_QH2OVap - z_ArgQH2OVap ) / ( 2.0_DP * DelTime )
z_DQH2OLiqDt = ( z_QH2OLiq - z_ArgQH2OLiq ) / ( 2.0_DP * DelTime )
z_DQH2OSolDt = ( z_QH2OSol - z_ArgQH2OSol ) / ( 2.0_DP * DelTime )
z_DUDt = ( z_U - z_ArgU ) / ( 2.0_DP * DelTime )
z_DVDt = ( z_V - z_ArgV ) / ( 2.0_DP * DelTime )
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1D
| Subroutine : | |
| r_Press(0:kmax) : | real(DP), intent(in) |
| z_TempB(1:kmax) : | real(DP), intent(in) |
| z_QH2OVapB(1:kmax) : | real(DP), intent(in) |
| z_QH2OLiqB(1:kmax) : | real(DP), intent(in) |
| z_QH2OSolB(1:kmax) : | real(DP), intent(in) |
| z_UB(1:kmax) : | real(DP), intent(in) |
| z_VB(1:kmax) : | real(DP), intent(in) |
| z_Temp(1:kmax) : | real(DP), intent(in) |
| z_QH2OVap(1:kmax) : | real(DP), intent(in) |
| z_QH2OLiq(1:kmax) : | real(DP), intent(in) |
| z_QH2OSol(1:kmax) : | real(DP), intent(in) |
| SurfRainFlux : | real(DP), intent(in) |
| SurfSnowFlux : | real(DP), intent(in) |
| z_U(1:kmax) : | real(DP), intent(in) |
| z_V(1:kmax) : | real(DP), intent(in) |
subroutine RASWithIce1DChkCons( r_Press, z_TempB, z_QH2OVapB, z_QH2OLiqB, z_QH2OSolB, z_UB, z_VB, z_Temp , z_QH2OVap , z_QH2OLiq , z_QH2OSol, SurfRainFlux, SurfSnowFlux, z_U , z_V )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
real(DP), intent(in) :: r_Press (0:kmax)
real(DP), intent(in) :: z_TempB (1:kmax)
real(DP), intent(in) :: z_QH2OVapB(1:kmax)
real(DP), intent(in) :: z_QH2OLiqB(1:kmax)
real(DP), intent(in) :: z_QH2OSolB(1:kmax)
real(DP), intent(in) :: z_UB (1:kmax)
real(DP), intent(in) :: z_VB (1:kmax)
real(DP), intent(in) :: z_Temp (1:kmax)
real(DP), intent(in) :: z_QH2OVap (1:kmax)
real(DP), intent(in) :: z_QH2OLiq (1:kmax)
real(DP), intent(in) :: z_QH2OSol (1:kmax)
real(DP), intent(in) :: SurfRainFlux
real(DP), intent(in) :: SurfSnowFlux
real(DP), intent(in) :: z_U (1:kmax)
real(DP), intent(in) :: z_V (1:kmax)
! Local variables
!
real(DP) :: xyz_DelMass(1:kmax)
real(DP) :: Val
real(DP) :: SumB
real(DP) :: Sum
real(DP) :: Ratio
integer :: k
do k = 1, kmax
xyz_DelMass(k) = ( r_Press(k-1) - r_Press(k) ) / Grav
end do
Sum = 0.0_DP
do k = kmax, 1, -1
Val = CpDry * z_TempB(k) + LatentHeat * z_QH2OVapB(k) - LatentHeatFusion * z_QH2OSolB(k)
Sum = Sum + Val * xyz_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = CpDry * z_Temp(k) + LatentHeat * z_QH2OVap(k) - LatentHeatFusion * z_QH2OSol(k)
Sum = Sum + Val * xyz_DelMass(k)
end do
Sum = Sum - LatentHeatFusion * SurfSnowFlux * ( 2.0_DP * DelTime )
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'Modified condensate static energy is not conserved, %f.', d = (/ Ratio /) )
end if
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_QH2OVapB(k) + z_QH2OLiqB(k) + z_QH2OSolB(k)
Sum = Sum + Val * xyz_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_QH2OVap (k) + z_QH2OLiq (k) + z_QH2OSol (k)
Sum = Sum + Val * xyz_DelMass(k)
end do
Sum = Sum + ( SurfRainFlux + SurfSnowFlux ) * ( 2.0_DP * DelTime )
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'H2O mass is not conserved, %f.', d = (/ Ratio /) )
end if
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_UB(k)
Sum = Sum + Val * xyz_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_U (k)
Sum = Sum + Val * xyz_DelMass(k)
end do
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'Zonal momentum is not conserved, %f.', d = (/ Ratio /) )
end if
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_VB(k)
Sum = Sum + Val * xyz_DelMass(k)
end do
SumB = Sum
Sum = 0.0_DP
do k = kmax, 1, -1
Val = z_V (k)
Sum = Sum + Val * xyz_DelMass(k)
end do
Ratio = ( Sum - SumB ) / ( Sum + 1.0d-100 )
if ( abs( Ratio ) > 1.0d-10 ) then
call MessageNotify( 'M', module_name, 'Meridional momentum is not conserved, %f.', d = (/ Ratio /) )
end if
end subroutine RASWithIce1DChkCons
| Subroutine : | |||||
| l : | integer , intent(in ) | ||||
| z_Press(1:kmax) : | real(DP), intent(in )
| ||||
| r_Press(0:kmax) : | real(DP), intent(in )
| ||||
| z_Exner(1:kmax) : | real(DP), intent(in )
| ||||
| r_Exner(0:kmax) : | real(DP), intent(in )
| ||||
| z_Temp(1:kmax) : | real(DP), intent(in )
| ||||
| z_QH2OVap(1:kmax) : | real(DP), intent(in )
| ||||
| z_QH2OLiq(1:kmax) : | real(DP), intent(in ) | ||||
| z_QH2OSol(1:kmax) : | real(DP), intent(in ) | ||||
| z_U(1:kmax) : | real(DP), intent(in ) | ||||
| z_V(1:kmax) : | real(DP), intent(in ) | ||||
| IndexMixLayTop : | integer , intent(in ) | ||||
| z_DelPress(1:kmax) : | real(DP), intent(in )
| ||||
| z_Beta(1:kmax) : | real(DP), intent(in ) | ||||
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) | ||||
| z_DetCldWatCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| z_DetCldIceCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| z_PotTemp(1:kmax) : | real(DP), intent(out )
| ||||
| z_DelNormMassFlux(1:kmax) : | real(DP), intent(out ) | ||||
| DelNormMassFluxCldTop : | real(DP), intent(out )
| ||||
| r_NormMassFlux(0:kmax) : | real(DP), intent(out ) | ||||
| NormMassFluxCldTop : | real(DP), intent(out ) | ||||
| CldQH2OLiqCldTop : | real(DP), intent(out )
| ||||
| CldQH2OSolCldTop : | real(DP), intent(out ) | ||||
| CWF : | real(DP), intent(out )
| ||||
| EntParam : | real(DP), intent(out )
| ||||
| z_Mu(1:kmax) : | real(DP), intent(out ) | ||||
| z_Eps(1:kmax) : | real(DP), intent(out ) | ||||
| z_Gamma(1:kmax) : | real(DP), intent(out ) | ||||
| z_GammaDSE(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OVap(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OLiq(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OSol(1:kmax) : | real(DP), intent(out )
| ||||
| GammaQRainDetLev : | real(DP), intent(out )
| ||||
| GammaQSnowDetLev : | real(DP), intent(out )
| ||||
| z_GammaU(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaV(1:kmax) : | real(DP), intent(out )
| ||||
| FlagEntParamOrderInapp : | logical , intent(out )
| ||||
| FlagNegH2OCondCldTop : | logical , intent(out )
| ||||
| rz_CldTemp(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OVap(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OLiq(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OSol(0:kmax, 1:kmax) : | real(DP), intent(inout), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTemp, z_DelNormMassFlux, DelNormMassFluxCldTop, r_NormMassFlux, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, CWF, EntParam, z_Mu, z_Eps, z_Gamma, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, GammaQRainDetLev, GammaQSnowDetLev, z_GammaU, z_GammaV, FlagEntParamOrderInapp, FlagNegH2OCondCldTop, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only : SaturateWatFraction
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_Press (1:kmax)
! Pressure
real(DP), intent(in ) :: r_Press (0:kmax)
! Pressure
real(DP), intent(in ) :: z_Exner (1:kmax)
! Exner function
real(DP), intent(in ) :: r_Exner (0:kmax)
! Exner function
real(DP), intent(in ) :: z_Temp (1:kmax)
! Temperature
real(DP), intent(in ) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(in ) :: z_QH2OLiq(1:kmax)
real(DP), intent(in ) :: z_QH2OSol(1:kmax)
real(DP), intent(in ) :: z_U(1:kmax)
real(DP), intent(in ) :: z_V(1:kmax)
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(in ) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop (1:kmax)
real(DP), intent(in ) :: z_DetCldWatCondFactor (1:kmax)
real(DP), intent(in ) :: z_DetCldIceCondFactor (1:kmax)
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: z_PotTemp (1:kmax)
! Potential temperature
!
! Difference of normalized mass flux between layer interface
real(DP), intent(out ) :: z_DelNormMassFlux (1:kmax)
real(DP), intent(out ) :: DelNormMassFluxCldTop
! Normalized mass flux at layer interface and cloud top
real(DP), intent(out ) :: r_NormMassFlux (0:kmax)
real(DP), intent(out ) :: NormMassFluxCldTop
! cloud water in cloud at cloud top
real(DP), intent(out ) :: CldQH2OLiqCldTop
! cloud ice in cloud at cloud top
real(DP), intent(out ) :: CldQH2OSolCldTop
real(DP), intent(out ) :: CWF
! Cloud work function
real(DP), intent(out ) :: EntParam
! Entrainment factor
real(DP), intent(out ) :: z_Mu (1:kmax)
real(DP), intent(out ) :: z_Eps (1:kmax)
real(DP), intent(out ) :: z_Gamma (1:kmax)
real(DP), intent(out ) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
!!$ real(DP), intent(out ) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OVap (1:kmax)
! Tendency of water vapor per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OLiq (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OSol (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(out ) :: GammaQRainDetLev
! Tendency of rain per unit mass flux
real(DP), intent(out ) :: GammaQSnowDetLev
! Tendency of snow per unit mass flux
real(DP), intent(out ) :: z_GammaU (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP), intent(out ) :: z_GammaV (1:kmax)
! Tendency of zonal wind per unit mass flux
!!$ real(DP), intent(out ) :: z_GammaQOthers (1:kmax)
!!$ ! Tendency of passive constituents per unit mass flux
logical , intent(out ) :: FlagEntParamOrderInapp
! Flags for modification of
logical , intent(out ) :: FlagNegH2OCondCldTop
! Flags for modification of
real(DP), intent(inout), optional :: rz_CldTemp (0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OVap(0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OLiq(0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OSol(0:kmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_Height (1:kmax)
!
! Height
real(DP) :: r_Height (0:kmax)
!
! Height
real(DP) :: z_QH2OVapSat(1:kmax)
! 飽和比湿.
! Saturation specific humidity.
! Dry and moist static energy in environment (Env) and cloud (Cld)
!
real(DP) :: z_EnvDryStaticEne (1:kmax)
real(DP) :: r_EnvDryStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEne (1:kmax)
real(DP) :: r_EnvMoistStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEneSat(1:kmax)
real(DP) :: r_EnvMoistStaticEneSat(0:kmax)
real(DP) :: z_EnvCondStaticEne (1:kmax)
real(DP) :: r_CldMoistStaticEne (0:kmax)
real(DP) :: r_CldCondStaticEne (0:kmax)
!!$ real(DP) :: CldCondStaticEneCldTop
real(DP) :: r_QH2OVap(0:kmax)
real(DP) :: r_QH2OLiq(0:kmax)
real(DP) :: r_QH2OSol(0:kmax)
real(DP) :: r_U(0:kmax)
real(DP) :: r_V(0:kmax)
real(DP) :: z_EntParam (1:kmax)
! Entrainment factor (variable for output)
!!$ real(DP) :: EntParamLL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! higher level
real(DP) :: CldMoistStaticEneCldTopUL
real(DP) :: CldQH2OVapCldTopUL
real(DP) :: EntParamUL
! Entrainment factor for a cloud with top at one layer
! lower level
! cloud total water in cloud
real(DP) :: r_CldQH2OTot(0:kmax)
! cloud total water in cloud at cloud top
real(DP) :: CldQH2OTotCldTop
! cloud condensate in cloud at cloud top
real(DP) :: CldQH2OCondCldTop
! water vapor in cloud at cloud top
real(DP) :: CldQH2OVapCldTop
real(DP) :: WatFrac
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
real(DP) :: CldTempB
real(DP) :: a_DQVapSatDTemp(1:1)
real(DP) :: DelTemp
real(DP) :: r_CldTemp (0:kmax)
real(DP) :: r_CldQH2OVap(0:kmax)
real(DP) :: r_CldQH2OLiq(0:kmax)
real(DP) :: r_CldQH2OSol(0:kmax)
real(DP) :: r_CldHeight (0:kmax)
real(DP) :: r_CldDryStaticEne(0:kmax)
!!$ real(DP) :: DEntParamDQH2OSol
!!$ real(DP) :: DelCldQH2OSolCldTop
real(DP) :: CldMoistStaticEneCldTop
real(DP) :: NormH2OTotFlux
real(DP) :: r_CldU (0:kmax)
real(DP) :: r_CldV (0:kmax)
real(DP) :: z_Val (1:kmax)
real(DP) :: r_Val (0:kmax)
real(DP) :: r_CldVal (0:kmax)
real(DP) :: z_GammaVal (1:kmax)
real(DP) :: NormValFlux
real(DP) :: CldUCldTop
real(DP) :: CldVCldTop
real(DP) :: CldValCldTop
real(DP) :: z_MuPrime (1:kmax)
real(DP) :: z_EpsPrime(1:kmax)
real(DP) :: RainConvFactor
real(DP) :: SnowConvFactor
!!$ real(DP) :: TmpSum
integer :: loopmax = 100
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer :: m
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
if ( z_Press(l) < RainSnowConvFactor0Press ) then
RainConvFactor = RainSnowConvFactor0
else if ( z_Press(l) < RainSnowConvFactor1Press ) then
RainConvFactor = ( RainSnowConvFactor0 - RainSnowConvFactor1 ) / ( RainSnowConvFactor0Press - RainSnowConvFactor1Press ) * ( z_Press(l) - RainSnowConvFactor1Press ) + RainSnowConvFactor1
else
RainConvFactor = RainSnowConvFactor1
end if
SnowConvFactor = RainConvFactor
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
! Potential temperature
!
z_PotTemp = z_Temp / z_Exner
! Saturation mixing ratio
!
z_QH2OVapSat = a_CalcQVapSat( z_Temp, z_Press )
! Calculation of dry and moist static energies
!
z_EnvDryStaticEne = CpDry * z_Temp + Grav * z_Height
z_EnvMoistStaticEne = z_EnvDryStaticEne + LatentHeat * z_QH2OVap
!
k = 0
r_EnvDryStaticEne (k) = 1.0d100
r_EnvMoistStaticEne(k) = 1.0d100
do k = 1, kmax-1
r_EnvDryStaticEne (k) = ( z_EnvDryStaticEne (k) + z_EnvDryStaticEne (k+1) ) / 2.0_DP
r_EnvMoistStaticEne(k) = ( z_EnvMoistStaticEne(k) + z_EnvMoistStaticEne(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvDryStaticEne (k) = z_EnvDryStaticEne (k)
r_EnvMoistStaticEne(k) = z_EnvMoistStaticEne(k)
! Calculation of saturated moist static energy
!
z_EnvMoistStaticEneSat = z_EnvDryStaticEne + LatentHeat * z_QH2OVapSat
!
k = 0
r_EnvMoistStaticEneSat(k) = 1.0d100
do k = 1, kmax-1
r_EnvMoistStaticEneSat(k) = ( z_EnvMoistStaticEneSat(k) + z_EnvMoistStaticEneSat(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvMoistStaticEneSat(k) = z_EnvMoistStaticEneSat(k)
! Calculation of saturated moist static energy
!
z_EnvCondStaticEne = z_EnvMoistStaticEne - LatentHeatFusion * z_QH2OSol
k = 0
r_QH2OVap(k) = 1.0d100
r_QH2OLiq(k) = 1.0d100
r_QH2OSol(k) = 1.0d100
do k = 1, kmax-1
r_QH2OVap(k) = ( z_QH2OVap(k) + z_QH2OVap(k+1) ) / 2.0_DP
r_QH2OLiq(k) = ( z_QH2OLiq(k) + z_QH2OLiq(k+1) ) / 2.0_DP
r_QH2OSol(k) = ( z_QH2OSol(k) + z_QH2OSol(k+1) ) / 2.0_DP
end do
k = kmax
r_QH2OVap(k) = z_QH2OVap(k)
r_QH2OLiq(k) = z_QH2OLiq(k)
r_QH2OSol(k) = z_QH2OSol(k)
k = 0
r_U(k) = 1.0d100
r_V(k) = 1.0d100
do k = 1, kmax-1
r_U(k) = ( z_U(k) + z_U(k+1) ) / 2.0_DP
r_V(k) = ( z_V(k) + z_V(k+1) ) / 2.0_DP
end do
k = kmax
r_U(k) = z_U(k)
r_V(k) = z_V(k)
! Entrainment parameter
!
!!$ ! cloud condensate static energy at cloud top
!!$ CldCondStaticEneCldTop = &
!!$ & z_EnvMoistStaticEneSat(l) - LatentHeatFusion * CldQH2OSolCldTop
! Entrainment parameter
!
CldMoistStaticEneCldTop = z_EnvMoistStaticEneSat(l)
CldQH2OVapCldTop = z_QH2OVapSat(l)
call RASWithIce1DEntParam( l, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvCondStaticEne, CldQH2OVapCldTop, CldMoistStaticEneCldTop, IndexMixLayTop, EntParam )
! subroutines below are commented out temporarily
!!$ if ( l >= 3 ) then
!!$ call RASEntParam1D( &
!!$ & l-1, & ! (in)
!!$ & z_Beta, z_BetaCldTop, z_PotTemp, & ! (in)
!!$ & z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, & ! (in)
!!$ & IndexMixLayTop, & ! (in)
!!$ & EntParamLL & ! (out)
!!$ & )
!!$ else
!!$ EntParamLL = 1.0d100
!!$ end if
if ( l <= kmax-1 ) then
!!$ call RASEntParam1D( &
!!$ & l+1, & ! (in)
!!$ & z_Beta, z_BetaCldTop, z_PotTemp, & ! (in)
!!$ & z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, & ! (in)
!!$ & IndexMixLayTop, & ! (in)
!!$ & EntParamUL & ! (out)
!!$ & )
CldMoistStaticEneCldTopUL = z_EnvMoistStaticEneSat(l+1)
CldQH2OVapCldTopUL = z_QH2OVapSat(l+1)
call RASWithIce1DEntParam( l+1, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvCondStaticEne, CldQH2OVapCldTopUL, CldMoistStaticEneCldTopUL, IndexMixLayTop, EntParamUL )
else
EntParamUL = 1.0d100
end if
! for output
z_EntParam(l) = EntParam
! Check variation of entrainment parameter with altitude
FlagEntParamOrderInapp = .false.
if ( ( EntParam > 0.0_DP ) .and. ( EntParamUL > 0.0_DP ) ) then
if ( EntParam < EntParamUL ) then
FlagEntParamOrderInapp = .true.
end if
end if
! Difference of normalized mass flux
!
! difference of normalized mass flux between layer bottom and top
!
z_DelNormMassFlux(1) = 1.0d100
do k = 2, l-1
z_DelNormMassFlux(k) = - EntParam * z_Beta(k) * z_PotTemp(k)
end do
do k = l, kmax
z_DelNormMassFlux(k) = 1.0d100
end do
!
! difference of normalized mass flux between layer bottom and mid-point
!
DelNormMassFluxCldTop = - EntParam * z_BetaCldTop(l) * z_PotTemp(l)
! Normalized mass flux
!
! normalized mass flux at layer interface
!
r_NormMassFlux(0) = 0.0_DP
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_NormMassFlux(k) = 0.0_DP
else if ( k == IndexMixLayTop ) then
r_NormMassFlux(k) = 1.0_DP
else
r_NormMassFlux(k) = r_NormMassFlux(k-1) - z_DelNormMassFlux(k)
end if
end do
do k = l, kmax
r_NormMassFlux(k) = 0.0_DP
end do
!
! normalized mass flux at cloud top (at layer mid-point)
!
NormMassFluxCldTop = r_NormMassFlux(l-1) - DelNormMassFluxCldTop
! Liquid water content at top of clouds
! If l is less than xy_IndexMixLayTop(i,j), i.e. the cloud top is below
! top of mixed layer, xy_SumTmp is zero, then, xy_CldQH2OLiqCldTop is
! also zero.
!
!!$ if ( l > IndexMixLayTop ) then
if ( ( l > IndexMixLayTop ) .and. ( EntParam > 0.0_DP ) ) then
do k = 0, IndexMixLayTop-1
r_CldQH2OTot(k) = 1.0d100
end do
k = IndexMixLayTop
!!$ NormH2OTotFlux = z_QH2OVap(k) * r_NormMassFlux(k)
NormH2OTotFlux = ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) ) * r_NormMassFlux(k)
r_CldQH2OTot(k) = NormH2OTotFlux / r_NormMassFlux(k)
do k = IndexMixLayTop+1, l-1
!!$ r_CldQH2OTot(k) = r_CldQH2OTot(k-1) * r_NormMassFlux(k-1) ######&
!!$ & - z_DelNormMassFlux(k) &
!!$ & * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
NormH2OTotFlux = NormH2OTotFlux - z_DelNormMassFlux(k) * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
r_CldQH2OTot(k) = NormH2OTotFlux / r_NormMassFlux(k)
end do
NormH2OTotFlux = NormH2OTotFlux - DelNormMassFluxCldTop * ( z_QH2OVap(l) + z_QH2OLiq(l) + z_QH2OSol(l) )
CldQH2OTotCldTop = NormH2OTotFlux / NormMassFluxCldTop
do k = l, kmax
r_CldQH2OTot(k) = 1.0d100
end do
else
r_CldQH2OTot = 0.0_DP
CldQH2OTotCldTop = 0.0_DP
end if
!!$ CldQH2OCondCldTop = CldQH2OTotCldTop - z_QH2OVapSat(l)
CldQH2OCondCldTop = CldQH2OTotCldTop - CldQH2OVapCldTop
! This is old version
! In this version, CldQH2OLiqCldTop and CldQH2OSolCldTop are calculated
! in RASEntParamWithIce1D subroutine.
! These values can be calculated from CldQH2OTotCldTop, which should be
! same as a value calculated in current manner.
!!$ CldQH2OCondCldTop = CldQH2OLiqCldTop + CldQH2OSolCldTop
! Check whether kernel is positive or negative.
!
!!$ if ( CldQH2OCondCldTop < 0.0_DP ) then
if ( CldQH2OCondCldTop < 0.0_DP ) then
FlagNegH2OCondCldTop = .true.
else
FlagNegH2OCondCldTop = .false.
end if
! avoid negative value
CldQH2OCondCldTop = max( CldQH2OCondCldTop, 0.0_DP )
call SaturateWatFraction( z_Temp(l), WatFrac )
CldQH2OLiqCldTop = WatFrac * CldQH2OCondCldTop
CldQH2OSolCldTop = ( 1.0_DP - WatFrac ) * CldQH2OCondCldTop
! Condensate static energy and moist static energy in clouds
!
r_CldCondStaticEne(0) = 1.0d100
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_CldCondStaticEne(k) = 1.0d100
else if ( k == IndexMixLayTop ) then
r_CldCondStaticEne(k) = z_EnvCondStaticEne(IndexMixLayTop)
else
r_CldCondStaticEne(k) = ( r_NormMassFlux(k-1) * r_CldCondStaticEne(k-1) - z_DelNormMassFlux(k) * z_EnvCondStaticEne(k) ) / r_NormMassFlux(k)
end if
end do
do k = l, kmax
r_CldCondStaticEne(k) = 1.0d100
end do
if ( EntParam >= 0.0_DP ) then
! Calculation of cloud air temperature
! This value will not be used below.
! This is an attempt for next extention.
!
do k = 0, IndexMixLayTop-1
r_CldTemp (k) = 1.0d100
r_CldQH2OVap (k) = 1.0d100
r_CldQH2OLiq (k) = 1.0d100
r_CldQH2OSol (k) = 1.0d100
r_CldHeight (k) = 1.0d100
r_CldMoistStaticEne(k) = 1.0d100
end do
k = IndexMixLayTop
r_CldTemp (k) = z_Temp(k)
r_CldQH2OVap(k) = z_QH2OVap(k)
r_CldQH2OLiq(k) = z_QH2OLiq(k)
r_CldQH2OSol(k) = z_QH2OSol(k)
r_CldHeight (k) = r_Height(k)
r_CldMoistStaticEne(k) = r_CldCondStaticEne(k) + LatentHeatFusion * r_CldQH2OSol(k)
do k = IndexMixLayTop+1, l-1
! Iteration
! Initialization
if ( k == IndexMixLayTop+1 ) then
r_CldTemp(k) = z_Temp(k)
else
r_CldTemp(k) = r_CldTemp(k-1)
end if
!
! It is assumed that WatFrac does not change during iteration, since
! variable WatFrac causes non-convergence of iteration sometime.
call SaturateWatFraction( r_CldTemp(k), WatFrac )
!
loop_cloud_properties : do m = 1, loopmax
CldTempB = r_CldTemp(k)
r_CldQH2OVap(k:k) = a_CalcQVapSat( r_CldTemp(k:k), r_Press(k:k) )
a_DQVapSatDTemp(1:1) = a_CalcDQVapSatDTemp( r_CldTemp(k:k), r_CldQH2OVap(k:k) )
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
DelTemp = ( r_CldCondStaticEne(k) - CpDry * r_CldTemp(k) - Grav * r_CldHeight(k) - ( LatentHeat + LatentHeatFusion * ( 1.0_DP - WatFrac ) ) * r_CldQH2OVap(k) + LatentHeatFusion * ( 1.0_DP - WatFrac ) * r_CldQH2OTot(k) ) / ( CpDry + ( LatentHeat + LatentHeatFusion * ( 1.0_DP - WatFrac ) ) * a_DQVapSatDTemp(1) + z_Beta(k) / r_Exner(k) / 2.0_DP )
r_CldTemp (k) = r_CldTemp (k) + DelTemp
r_CldQH2OVap(k) = r_CldQH2OVap(k) + a_DQVapSatDTemp(1) * DelTemp
! update height by the use of updated temperature
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
!!$ write( 6, * ) EntParam, l, k, m, r_CldMoistStaticEne(k), Grav * r_CldHeight(k), r_CldTemp(k), r_CldQH2OVap(k)
!!$ if ( abs( CldTempB - r_CldTemp(k) ) / CldTempB < 1.0d-3 ) &
if ( abs( DelTemp ) < 1.0d-3 ) exit loop_cloud_properties
end do loop_cloud_properties
if ( m >= loopmax ) then
call MessageNotify( 'E', module_name, 'Number of loop for cloud properties is too large, %d.', i = (/m/) )
end if
if ( ( r_CldQH2OTot(k) - r_CldQH2OVap(k) ) >= 0.0_DP ) then
! cloud water and cloud ice
call SaturateWatFraction( r_CldTemp(k), WatFrac )
!
r_CldQH2OLiq(k) = ( r_CldQH2OTot(k) - r_CldQH2OVap(k) ) * WatFrac
r_CldQH2OSol(k) = r_CldQH2OTot(k) - r_CldQH2OVap(k) - r_CldQH2OLiq(k)
else
r_CldQH2OVap(k) = r_CldQH2OTot(k )
r_CldQH2OLiq(k) = 0.0_DP
r_CldQH2OSol(k) = 0.0_DP
!
r_CldTemp (k) = ( r_CldCondStaticEne(k) - Grav * r_CldHeight(k-1) - Grav * z_Beta(k) * r_CldTemp(k-1) / r_Exner(k-1) / 2.0_DP - LatentHeat * r_CldQH2OVap(k) + LatentHeatFusion * r_CldQH2OSol(k) ) / ( CpDry + Grav * z_Beta(k) / r_Exner(k) / 2.0_DP )
! r_CldHeight is estimated again with a new temperature
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
end if
r_CldMoistStaticEne(k) = r_CldCondStaticEne(k) + LatentHeatFusion * r_CldQH2OSol(k)
end do
do k = l, kmax
r_CldTemp (k) = 1.0d100
r_CldQH2OVap (k) = 1.0d100
r_CldQH2OLiq (k) = 1.0d100
r_CldQH2OSol (k) = 1.0d100
r_CldMoistStaticEne(k) = 1.0d100
end do
do k = 0, IndexMixLayTop-1
r_CldDryStaticEne(k) = 1.0d100
end do
do k = IndexMixLayTop, l-1
r_CldDryStaticEne(k) = CpDry * r_CldTemp(k) + Grav * r_CldHeight(k)
end do
do k = l, kmax
r_CldDryStaticEne(k) = 1.0d100
end do
else
r_CldTemp = 1.0d100
r_CldQH2OVap = 1.0d100
r_CldQH2OLiq = 1.0d100
r_CldQH2OSol = 1.0d100
r_CldMoistStaticEne = 1.0d100
r_CldDryStaticEne = 1.0d100
end if
if ( present( rz_CldTemp ) ) rz_CldTemp (:,l) = r_CldTemp
if ( present( rz_CldQH2OVap ) ) rz_CldQH2OVap(:,l) = r_CldQH2OVap
if ( present( rz_CldQH2OLiq ) ) rz_CldQH2OLiq(:,l) = r_CldQH2OLiq
if ( present( rz_CldQH2OSol ) ) rz_CldQH2OSol(:,l) = r_CldQH2OSol
!###############################################
! Check whether a parcel in cloud has moist static energy larger than environment's
!
!!$ xy_FlagCrossSatEquivPotTemp = .false.
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ do k = xy_IndexMixLayTop(i,j), l-1
!!$ if ( xyr_EnvMoistStaticEneSat(i,j,k) < xyr_CldMoistStaticEne(i,j,k) ) then
!!$ xy_FlagCrossSatEquivPotTemp(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!###############################################
! Cloud work function
!
! Auxiliary variables
!
z_Gamma = LatentHeat / CpDry * a_CalcDQVapSatDTemp( z_Temp, z_QH2OVapSat )
!
k = 1
z_Mu (k) = 1.0d100
z_Eps(k) = 1.0d100
do k = 2, kmax
z_Mu (k) = ( z_Exner(k ) - r_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
z_Eps(k) = ( r_Exner(k-1) - z_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
end do
!
! Cloud work function
!
! approximation form
!
!!$ CWF = 0.0_DP
!!$ do k = 2, l-1
!!$ if ( k > IndexMixLayTop ) then
!!$ CWF = CWF &
!!$ & + z_Mu (k) * r_NormMassFlux(k ) &
!!$ & * ( r_CldMoistStaticEne(k ) - z_EnvMoistStaticEneSat(k) ) &
!!$ & + z_Eps(k) * r_NormMassFlux(k-1) &
!!$ & * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
!!$ end if
!!$ end do
!!$ k = l
!!$ if ( k > IndexMixLayTop ) then
!!$ CWF = CWF &
!!$ & + z_Eps(k) * r_NormMassFlux(k-1) &
!!$ & * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
!!$ end if
!
! original form
!
k = 1
z_MuPrime (k) = 1.0d100
z_EpsPrime(k) = 1.0d100
do k = 2, kmax
z_MuPrime (k) = ( z_Exner(k ) - r_Exner(k) ) / z_Exner(k)
z_EpsPrime(k) = ( r_Exner(k-1) - z_Exner(k) ) / z_Exner(k)
end do
CWF = 0.0_DP
do k = 2, l-1
if ( k > IndexMixLayTop ) then
CWF = CWF + z_MuPrime (k) * r_NormMassFlux(k ) * ( r_CldDryStaticEne(k ) - z_EnvDryStaticEne(k) ) + z_EpsPrime(k) * r_NormMassFlux(k-1) * ( r_CldDryStaticEne(k-1) - z_EnvDryStaticEne(k) )
end if
end do
k = l
if ( k > IndexMixLayTop ) then
CWF = CWF + z_EpsPrime(k) * r_NormMassFlux(k-1) * ( r_CldDryStaticEne(k-1) - z_EnvDryStaticEne(k) )
end if
! Tendency of dry static energy per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaDSE(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_EnvDryStaticEne(k ) - z_EnvDryStaticEne(k+1) )
else
z_GammaDSE(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaDSE(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_EnvDryStaticEne(k-1) - z_EnvDryStaticEne(k) ) + r_NormMassFlux(k ) * ( z_EnvDryStaticEne(k ) - r_EnvDryStaticEne(k) ) )
end do
end if
k = l
z_GammaDSE(k) = z_GammaDSE(k) - Grav / z_DelPress(k) * LatentHeat * CldQH2OLiqCldTop * NormMassFluxCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) ) - Grav / z_DelPress(k) * LatentHeatFusion * CldQH2OSolCldTop * NormMassFluxCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaDSE(k) = 0.0_DP
end do
! Tendency of moist static energy per unit mass flux
!
!!$ do k = 1, l
!!$ z_GammaMSE(k) = &
!!$ & - Grav / z_DelPress(k) &
!!$ & * ( r_NormMassFlux(k-1) &
!!$ & * ( r_EnvMoistStaticEne(k-1) - z_EnvMoistStaticEne(k) ) &
!!$ & + r_NormMassFlux(k ) &
!!$ & * ( z_EnvMoistStaticEne(k ) - r_EnvMoistStaticEne(k) ) &
!!$ & )
!!$ end do
!!$ k = l
!!$ z_GammaMSE(k) = z_GammaMSE(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( z_EnvMoistStaticEneSat(k) - z_EnvMoistStaticEne(k) )
!!$ do k = l+1, kmax
!!$ z_GammaMSE(k) = 0.0_DP
!!$ end do
! Tendency of water vapor per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaQH2OVap(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_QH2OVap(k ) - z_QH2OVap(k+1) )
else
z_GammaQH2OVap(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaQH2OVap(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_QH2OVap(k-1) - z_QH2OVap(k) ) + r_NormMassFlux(k ) * ( z_QH2OVap(k ) - r_QH2OVap(k) ) )
end do
end if
k = l
z_GammaQH2OVap(k) = z_GammaQH2OVap(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OVapCldTop - z_QH2OVap(k) ) + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) )
do k = l+1, kmax
z_GammaQH2OVap(k) = 0.0_DP
end do
! Tendency of cloud water per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaQH2OLiq(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_QH2OLiq(k ) - z_QH2OLiq(k+1) )
else
z_GammaQH2OLiq(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaQH2OLiq(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_QH2OLiq(k-1) - z_QH2OLiq(k) ) + r_NormMassFlux(k ) * ( z_QH2OLiq(k ) - r_QH2Oliq(k) ) )
end do
end if
k = l
!!$ z_GammaQH2OLiq(k) = z_GammaQH2OLiq(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( CldQH2OLiqCldTop - z_QH2OLiq(k) ) &
!!$ & - Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OLiqCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) ) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OSolCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
z_GammaQH2OLiq(k) = z_GammaQH2OLiq(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OLiqCldTop * ( 1.0_DP - RainConvFactor ) - z_QH2OLiq(k) ) - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * ( 1.0_DP - RainConvFactor ) * ( 1.0_DP - z_DetCldWatCondFactor(k) ) + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * ( 1.0_DP - SnowConvFactor ) * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaQH2OLiq(k) = 0.0_DP
end do
k = l
!!$ GammaQRainDetLev = 0.0_DP
GammaQRainDetLev = + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * RainConvFactor - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * RainConvFactor * ( 1.0_DP - z_DetCldWatCondFactor(k) ) + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * SnowConvFactor * ( 1.0_DP - z_DetCldIceCondFactor(k) )
! Tendency of cloud ice per unit mass flux
!
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaQH2OSol(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_QH2OSol(k ) - z_QH2OSol(k+1) )
else
z_GammaQH2OSol(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaQH2OSol(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_QH2OSol(k-1) - z_QH2OSol(k) ) + r_NormMassFlux(k ) * ( z_QH2OSol(k ) - r_QH2OSol(k) ) )
end do
end if
k = l
!!$ z_GammaQH2OSol(k) = z_GammaQH2OSol(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( CldQH2OSolCldTop - z_QH2OSol(k) ) &
!!$ & - Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OSolCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
z_GammaQH2OSol(k) = z_GammaQH2OSol(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OSolCldTop * ( 1.0_DP - SnowConvFactor ) - z_QH2OSol(k) ) - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * ( 1.0_DP - SnowConvFactor ) * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaQH2OSol(k) = 0.0_DP
end do
k = l
!!$ GammaQSnowDetLev = 0.0_DP
GammaQSnowDetLev = + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * SnowConvFactor - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * SnowConvFactor * ( 1.0_DP - z_DetCldIceCondFactor(k) )
! Tendency of zonal and meridional windsper unit mass flux
!
if ( FlagMomMix ) then
do m = 1, 2
select case ( m )
case ( 1 )
z_Val = z_U
r_Val = r_U
case ( 2 )
z_Val = z_V
r_Val = r_V
case default
call MessageNotify( 'E', module_name, 'Unexpected case.' )
end select
!
if ( l > IndexMixLayTop ) then
do k = 0, IndexMixLayTop-1
r_CldVal(k) = 1.0d100
end do
k = IndexMixLayTop
NormValFlux = z_Val(k) * r_NormMassFlux(k)
r_CldVal(k) = NormValFlux / r_NormMassFlux(k)
do k = IndexMixLayTop+1, l-1
NormValFlux = NormValFlux - z_DelNormMassFlux(k) * z_Val(k)
r_CldVal(k) = NormValFlux / r_NormMassFlux(k)
end do
NormValFlux = NormValFlux - DelNormMassFluxCldTop * z_Val(l)
CldValCldTop = NormValFlux / NormMassFluxCldTop
do k = l, kmax
r_CldVal(k) = 1.0d100
end do
else
r_CldVal = 0.0_DP
CldValCldTop = 0.0_DP
end if
if ( FlagUpWind ) then
do k = 1, l
if ( k < kmax ) then
z_GammaVal(k) = - Grav / z_DelPress(k) * r_NormMassFlux(k ) * ( z_Val(k ) - z_Val(k+1) )
else
z_GammaVal(k) = 0.0_DP
end if
end do
else
do k = 1, l
z_GammaVal(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_Val(k-1) - z_Val(k) ) + r_NormMassFlux(k ) * ( z_Val(k ) - r_Val(k) ) )
end do
end if
k = l
z_GammaVal(k) = z_GammaVal(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldValCldTop - z_Val(k) )
do k = l+1, kmax
z_GammaVal(k) = 0.0_DP
end do
!
select case ( m )
case ( 1 )
r_CldU = r_CldVal
CldUCldTop = CldValCldTop
z_GammaU = z_GammaVal
case ( 2 )
r_CldV = r_CldVal
CldVCldTop = CldValCldTop
z_GammaV = z_GammaVal
end select
end do
else
r_CldU = 1.0d100
CldUCldTop = 1.0d100
z_GammaU = 0.0_DP
r_CldV = 1.0d100
CldVCldTop = 1.0d100
z_GammaV = 0.0_DP
end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1DCore01
| Subroutine : | |||||
| l : | integer , intent(in ) | ||||
| z_DelPress(1:kmax) : | real(DP), intent(in )
| ||||
| z_GammaDSE(1:kmax) : | real(DP), intent(in )
| ||||
| z_GammaQH2OVap(1:kmax) : | real(DP), intent(in )
| ||||
| z_GammaQH2OLiq(1:kmax) : | real(DP), intent(in )
| ||||
| z_GammaQH2OSol(1:kmax) : | real(DP), intent(in )
| ||||
| GammaQRainDetLev : | real(DP), intent(in )
| ||||
| GammaQSnowDetLev : | real(DP), intent(in )
| ||||
| z_GammaU(1:kmax) : | real(DP), intent(in )
| ||||
| z_GammaV(1:kmax) : | real(DP), intent(in )
| ||||
| CldMassFluxBottom : | real(DP), intent(in )
| ||||
| z_DetCldWatCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| z_DetCldIceCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| NormMassFluxCldTop : | real(DP), intent(in ) | ||||
| CldQH2OLiqCldTop : | real(DP), intent(in ) | ||||
| CldQH2OSolCldTop : | real(DP), intent(in ) | ||||
| z_Temp(1:kmax) : | real(DP), intent(inout)
| ||||
| z_QH2OVap(1:kmax) : | real(DP), intent(inout)
| ||||
| z_QH2OLiq(1:kmax) : | real(DP), intent(inout)
| ||||
| z_QH2OSol(1:kmax) : | real(DP), intent(inout)
| ||||
| z_U(1:kmax) : | real(DP), intent(inout)
| ||||
| z_V(1:kmax) : | real(DP), intent(inout)
| ||||
| DQRainDt : | real(DP), intent(out) | ||||
| DQSnowDt : | real(DP), intent(out) |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, GammaQRainDetLev, GammaQSnowDetLev, z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, DQRainDt, DQSnowDt )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only : SaturateWatFraction
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP), intent(in ) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
!!$ real(DP), intent(in ) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP), intent(in ) :: z_GammaQH2OVap (1:kmax)
! Tendency of water vapor per unit mass flux
real(DP), intent(in ) :: z_GammaQH2OLiq (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(in ) :: z_GammaQH2OSol (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(in ) :: GammaQRainDetLev
! Tendency of rain per unit mass flux
real(DP), intent(in ) :: GammaQSnowDetLev
! Tendency of snow per unit mass flux
real(DP), intent(in ) :: z_GammaU (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP), intent(in ) :: z_GammaV (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP), intent(in ) :: CldMassFluxBottom
! Cloud mass flux at cloud bottom
real(DP), intent(in ) :: z_DetCldWatCondFactor (1:kmax)
real(DP), intent(in ) :: z_DetCldIceCondFactor (1:kmax)
real(DP), intent(in ) :: NormMassFluxCldTop
real(DP), intent(in ) :: CldQH2OLiqCldTop
real(DP), intent(in ) :: CldQH2OSolCldTop
real(DP), intent(inout) :: z_Temp (1:kmax)
! Temperature
real(DP), intent(inout) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(inout) :: z_QH2OLiq (1:kmax)
! $ ql $ . Specific liquid water content
real(DP), intent(inout) :: z_QH2OSol (1:kmax)
! $ qi$ . Specific ice content
real(DP), intent(inout) :: z_U (1:kmax)
! $ U $ . Zonal wind
real(DP), intent(inout) :: z_V (1:kmax)
! $ U $ . Meridional wind
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out) :: DQRainDt
real(DP), intent(out) :: DQSnowDt
! 作業変数
! Work variables
!
real(DP) :: z_DTempDtCumulus (1:kmax)
! 温度変化率.
! Temperature tendency
!!$ real(DP) :: z_DQVapDtCumulus (1:kmax)
!!$ ! 比湿変化率.
!!$ ! Specific humidity tendency
real(DP) :: z_DQH2OVapDtCumulus (1:kmax)
!
! Specific humidity tendency
real(DP) :: z_DQH2OLiqDtCumulus (1:kmax)
!
! Specific liquid water content tendency
real(DP) :: z_DQH2OSolDtCumulus (1:kmax)
!
! Specific ice content tendency
real(DP) :: z_DUDtCumulus (1:kmax)
!
! Zonal wind tendency
real(DP) :: z_DVDtCumulus (1:kmax)
!
! Meridional wind tendency
!!$ real(DP) :: z_DelH2OMass (1:kmax)
!!$ real(DP) :: H2OMassB
!!$ real(DP) :: H2OMassA
!!$ integer :: k ! 鉛直方向に回る DO ループ用作業変数
!!$ ! Work variables for DO loop in vertical direction
!!$ integer :: m
!!$ integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
! Tendencies
!
z_DTempDtCumulus = CldMassFluxBottom * z_GammaDSE / CpDry
!!$ z_DQVapDtCumulus = CldMassFluxBottom * ( z_GammaMSE - z_GammaDSE ) / LatentHeat
z_DQH2OVapDtCumulus = CldMassFluxBottom * z_GammaQH2OVap
z_DQH2OLiqDtCumulus = CldMassFluxBottom * z_GammaQH2OLiq
z_DQH2OSolDtCumulus = CldMassFluxBottom * z_GammaQH2OSol
DQRainDt = CldMassFluxBottom * GammaQRainDetLev
DQSnowDt = CldMassFluxBottom * GammaQSnowDetLev
z_DUDtCumulus = CldMassFluxBottom * z_GammaU
z_DVDtCumulus = CldMassFluxBottom * z_GammaV
! add tendencies to temperature and specific humidity
!
z_Temp = z_Temp + z_DTempDtCumulus * 2.0_DP * DelTime
!!$ z_QH2OVap = z_QH2OVap + z_DQVapDtCumulus * 2.0_DP * DelTime
z_QH2OVap = z_QH2OVap + z_DQH2OVapDtCumulus * 2.0_DP * DelTime
z_QH2OLiq = z_QH2OLiq + z_DQH2OLiqDtCumulus * 2.0_DP * DelTime
z_QH2OSol = z_QH2OSol + z_DQH2OSolDtCumulus * 2.0_DP * DelTime
z_U = z_U + z_DUDtCumulus * 2.0_DP * DelTime
z_V = z_V + z_DVDtCumulus * 2.0_DP * DelTime
! Precipitation rate at cloud top level
! unit is kg m-2 s-1
!
!!$ RainCumulus = CldMassFluxBottom * z_RainFactor(l) &
!!$ & * NormMassFluxCldTop * CldQH2OLiqCldTop
!
!!$ DQH2OLiqDt = CldMassFluxBottom * z_RainFactor(l) &
!!$ & * NormMassFluxCldTop * CldQH2OLiqCldTop
!!$ DQH2OLiqDt = DQH2OLiqDt / ( z_DelPress(l) / Grav )
!!$ !
!!$ DQH2OSolDt = CldMassFluxBottom * z_SnowFactor(l) &
!!$ & * NormMassFluxCldTop * CldQH2OSolCldTop
!!$ DQH2OSolDt = DQH2OSolDt / ( z_DelPress(l) / Grav )
! mass fix
!
!!$ z_DelH2OMass = z_QH2OVap * z_DelPress / Grav
!!$ ! total H2O mass in a vertical column
!!$ H2OMassB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ H2OMassB = H2OMassB + z_DelH2OMass(k)
!!$ end do
!!$ if ( H2OMassB < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'Mass of water vapor in a column is negative (%d,%d), %f.', &
!!$ & i = (/0,0/), d = (/H2OMassB/) )
!!$ end if
!!$ ! negative mass is borrowed from above
!!$ do k = 1, kmax-1
!!$ if ( z_DelH2OMass(k) < 0.0_DP ) then
!!$ z_DelH2OMass(k+1) = z_DelH2OMass(k+1) + z_DelH2OMass(k)
!!$ z_DelH2OMass(k ) = 0.0_DP
!!$ end if
!!$ end do
!!$ k = kmax
!!$ if ( z_DelH2OMass(k) < 0.0_DP ) then
!!$ z_DelH2OMass (k) = 0.0_DP
!!$ end if
!!$
!!$
!!$ ! total H2O mass in a vertical column, again
!!$ H2OMassA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ H2OMassA = H2OMassA + z_DelH2OMass(k)
!!$ end do
!!$ ! total mass in a vertical column is adjusted
!!$ if ( H2OMassA > 0.0_DP ) then
!!$ do k = 1, kmax
!!$ z_DelH2OMass(k) = z_DelH2OMass(k) &
!!$ & * H2OMassB / H2OMassA
!!$ end do
!!$ else
!!$ do k = 1, kmax
!!$ z_DelH2OMass(k) = 0.0_DP
!!$ end do
!!$ end if
!!$ z_QH2OVap = z_DelH2OMass / ( z_DelPress / Grav )
call RASWithIce1DCore02MassFixer( z_DelPress, z_QH2OVap )
call RASWithIce1DCore02MassFixer( z_DelPress, z_QH2OLiq )
call RASWithIce1DCore02MassFixer( z_DelPress, z_QH2OSol )
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1DCore02
| Subroutine : | |||
| z_DelPress(1:kmax) : | real(DP), intent(in )
| ||
| z_QH2OXXX(1:kmax) : | real(DP), intent(inout)
|
mass fixer for relaxed Arakawa-Schubert scheme
Change specific water content to fill negative values
subroutine RASWithIce1DCore02MassFixer( z_DelPress, z_QH2OXXX )
!
! mass fixer for relaxed Arakawa-Schubert scheme
!
! Change specific water content to fill negative values
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav
! $ g $ [m s-2].
! 重力加速度.
! Gravitational acceleration
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP), intent(inout) :: z_QH2OXXX (1:kmax)
! Specific water content
! 作業変数
! Work variables
!
real(DP) :: z_DelH2OMass (1:kmax)
real(DP) :: H2OMassB
real(DP) :: H2OMassA
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
! mass fix
!
z_DelH2OMass = z_QH2OXXX * z_DelPress / Grav
! total H2O mass in a vertical column
H2OMassB = 0.0_DP
do k = kmax, 1, -1
H2OMassB = H2OMassB + z_DelH2OMass(k)
end do
if ( H2OMassB < 0.0_DP ) then
!!$ call MessageNotify( 'E', module_name, &
call MessageNotify( 'M', module_name, 'Mass of water vapor in a column is negative, %f.', d = (/H2OMassB/) )
end if
! negative mass is borrowed from above
do k = 1, kmax-1
if ( z_DelH2OMass(k) < 0.0_DP ) then
z_DelH2OMass(k+1) = z_DelH2OMass(k+1) + z_DelH2OMass(k)
z_DelH2OMass(k ) = 0.0_DP
end if
end do
k = kmax
if ( z_DelH2OMass(k) < 0.0_DP ) then
z_DelH2OMass (k) = 0.0_DP
end if
! total H2O mass in a vertical column, again
H2OMassA = 0.0_DP
do k = kmax, 1, -1
H2OMassA = H2OMassA + z_DelH2OMass(k)
end do
! total mass in a vertical column is adjusted
if ( ( H2OMassB > 0.0_DP ) .and. ( H2OMassA > 0.0_DP ) ) then
do k = 1, kmax
z_DelH2OMass(k) = z_DelH2OMass(k) * H2OMassB / H2OMassA
end do
else
do k = 1, kmax
z_DelH2OMass(k) = 0.0_DP
end do
end if
z_QH2OXXX = z_DelH2OMass / ( z_DelPress / Grav )
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1DCore02MassFixer
| Subroutine : | |||||||
| l : | integer , intent(in ) | ||||||
| z_Temp(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OVap(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OLiq(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OSol(1:kmax) : | real(DP), intent(in ) | ||||||
| z_PotTemp(1:kmax) : | real(DP), intent(in ) | ||||||
| z_Beta(1:kmax) : | real(DP), intent(in ) | ||||||
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) | ||||||
| z_EnvCondStaticEne(1:kmax) : | real(DP), intent(in ) | ||||||
| CldQH2OVapCldTop : | real(DP), intent(in ) | ||||||
| CldMoistStaticEneCldTop : | real(DP), intent(in ) | ||||||
| IndexMixLayTop : | integer , intent(in ) | ||||||
| EntParam : | real(DP), intent(out)
|
エントレインメントパラメータの計算
Calculation of entrainment parameter
subroutine RASWithIce1DEntParam( l, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvCondStaticEne, CldQH2OVapCldTop, CldMoistStaticEneCldTop, IndexMixLayTop, EntParam )
!
! エントレインメントパラメータの計算
!
! Calculation of entrainment parameter
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only : SaturateWatFraction
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_Temp (1:kmax)
real(DP), intent(in ) :: z_QH2OVap (1:kmax)
real(DP), intent(in ) :: z_QH2OLiq (1:kmax)
real(DP), intent(in ) :: z_QH2OSol (1:kmax)
real(DP), intent(in ) :: z_PotTemp (1:kmax)
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop (1:kmax)
real(DP), intent(in ) :: z_EnvCondStaticEne (1:kmax)
real(DP), intent(in ) :: CldQH2OVapCldTop
real(DP), intent(in ) :: CldMoistStaticEneCldTop
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(out) :: EntParam
!!$ real(DP), intent(out) :: CldQH2OLiqCldTop
!!$ real(DP), intent(out) :: CldQH2OSolCldTop
! 作業変数
! Work variables
!
real(DP) :: WatFrac
real(DP) :: TmpA
real(DP) :: TmpB
real(DP) :: TmpC
!!$ real(DP) :: QETermA
!!$ real(DP) :: QETermB
!!$ real(DP) :: QETermC
!!$ real(DP) :: TmpSum
!!$ real(DP) :: CldQH2OCondCldTop
real(DP) :: Denom
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
! Entrainment parameter
!
if ( l > IndexMixLayTop ) then
call SaturateWatFraction( z_Temp(l), WatFrac )
TmpA = 0.0_DP
do k = IndexMixLayTop+1, l-1
TmpA = TmpA + z_Beta(k) * z_PotTemp(k)
end do
TmpA = TmpA + z_BetaCldTop(l) * z_PotTemp(l)
TmpB = 0.0_DP
do k = IndexMixLayTop+1, l-1
TmpB = TmpB + z_Beta(k) * z_PotTemp(k) * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
end do
TmpB = TmpB + z_BetaCldTop(l) * z_PotTemp(l) * ( z_QH2OVap(l) + z_QH2OLiq(l) + z_QH2OSol(l) )
TmpC = 0.0_DP
do k = IndexMixLayTop+1, l-1
TmpC = TmpC + z_Beta(k) * z_PotTemp(k) * ( CldMoistStaticEneCldTop - z_EnvCondStaticEne(k) )
end do
TmpC = TmpC + z_BetaCldTop(l) * z_PotTemp(l) * ( CldMoistStaticEneCldTop - z_EnvCondStaticEne(l) )
Denom = TmpC - LatentHeatFusion * ( 1.0_DP - WatFrac ) * ( TmpB - TmpA * CldQH2OVapCldTop )
if ( Denom == 0.0_DP ) then
EntParam = - 1.0_DP / TmpA
else
EntParam = ( ( z_EnvCondStaticEne(IndexMixLayTop) - CldMoistStaticEneCldTop ) + LatentHeatFusion * ( 1.0_DP - WatFrac ) * ( z_QH2OVap(IndexMixLayTop) + z_QH2OLiq(IndexMixLayTop) + z_QH2OSol(IndexMixLayTop) - CldQH2OVapCldTop ) ) / Denom
end if
!!$ CldQH2OCondCldTop = &
!!$ & ( z_QH2OVap(IndexMixLayTop) + EntParam * TmpB ) &
!!$ & / ( 1.0_DP + EntParam * TmpA ) &
!!$ & - CldQH2OVapCldTop
!!$ CldQH2OLiqCldTop = WatFrac * CldQH2OCondCldTop
!!$ CldQH2OSolCldTop = ( 1.0_DP - WatFrac ) * CldQH2OCondCldTop
else
EntParam = 0.0_DP
!!$ CldQH2OLiqCldTop = 0.0_DP
!!$ CldQH2OSolCldTop = 0.0_DP
end if
end subroutine RASWithIce1DEntParam
| Subroutine : | |||||||
| z_QH2OXXX(1:kmax) : | real(DP), intent(in )
| ||||||
| z_GammaQH2OXXX(1:kmax) : | real(DP), intent(in ) | ||||||
| CldMassFluxBottom : | real(DP), intent(inout) |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1DModMassFlux( z_QH2OXXX, z_GammaQH2OXXX, CldMassFluxBottom )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: z_QH2OXXX (1:kmax)
! Specific water content
!!$ real(DP), intent(in ) :: z_GammaDSE (1:kmax)
!!$ ! Tendency of dry static energy per unit mass flux
!!$ real(DP), intent(in ) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP), intent(in ) :: z_GammaQH2OXXX (1:kmax)
real(DP), intent(inout) :: CldMassFluxBottom
! 作業変数
! Work variables
!
! Variables for modification of cloud mass flux
!
real(DP) :: z_DQH2OXXXDt (1:kmax)
real(DP) :: z_QH2OXXXTentative(1:kmax)
real(DP) :: CldMassFluxCorFactor
real(DP) :: CldMassFluxCorFactorTentative
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
! Check values of cloud mass flux
! If water amount transported by convection is larger than that in a
! column, cloud mass flux is reduced.
!
! tendency of specific humidity is calculated tentatively
!!$ z_DQH2OXXXDt = &
!!$ & + CldMassFluxBottom * ( z_GammaMSE - z_GammaDSE ) &
!!$ & / LatentHeat
z_DQH2OXXXDt = CldMassFluxBottom * z_GammaQH2OXXX
! total H2O mass in a vertical column after RAS
z_QH2OXXXTentative = z_QH2OXXX + z_DQH2OXXXDt * 2.0_DP * DelTime
CldMassFluxCorFactor = 1.0_DP
do k = 1, kmax
if ( z_QH2OXXXTentative(k) < 0.0_DP ) then
CldMassFluxCorFactorTentative = z_QH2OXXX(k) / ( z_QH2OXXX(k) - z_QH2OXXXTentative(k) )
else
CldMassFluxCorFactorTentative = 1.0_DP
end if
if ( CldMassFluxCorFactorTentative < CldMassFluxCorFactor ) then
CldMassFluxCorFactor = CldMassFluxCorFactorTentative
end if
end do
! modify cloud mass flux
CldMassFluxBottom = CldMassFluxCorFactor * CldMassFluxBottom
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIce1DModMassFlux
| Subroutine : | |||||
| xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in )
| ||||
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_Exner(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyr_Exner(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgTemp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgQH2OVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgQH2OLiq(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgQH2OSol(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgU(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in )
| ||||
| xyz_ArgV(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in )
| ||||
| xyz_DTempDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_DQH2OVapDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_DQH2OSolDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_DUDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xyz_DVDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ) | ||||
| xy_SurfRainFlux(0:imax-1, 1:jmax) : | real(DP), intent(out )
| ||||
| xy_SurfSnowFlux(0:imax-1, 1:jmax) : | real(DP), intent(out )
| ||||
| xyz_MoistConvDetTend(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional | ||||
| xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIce1DWrapper3D( xy_SurfTemp, xyz_Press, xyr_Press, xyz_Exner, xyr_Exner, xyz_ArgTemp, xyz_ArgQH2OVap, xyz_ArgQH2OLiq, xyz_ArgQH2OSol, xyz_ArgU, xyz_ArgV, xyz_DTempDt, xyz_DQH2OVapDt, xyz_DQH2OLiqDt, xyz_DQH2OSolDt, xyz_DUDt, xyz_DVDt, xy_SurfRainFlux, xy_SurfSnowFlux, xyz_MoistConvDetTend, xyz_MoistConvSubsidMassFlux )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! OpenMP
!
!$ use omp_lib
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, LatentHeat
! $ L $ [J kg-1] .
! 凝結の潜熱.
! Latent heat of condensation
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: xy_SurfTemp (0:imax-1, 1:jmax)
! Pressure
real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! Pressure
real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! Pressure
real(DP), intent(in ) :: xyz_Exner (0:imax-1, 1:jmax, 1:kmax)
! Exner function
real(DP), intent(in ) :: xyr_Exner (0:imax-1, 1:jmax, 0:kmax)
! Exner function
real(DP), intent(in ) :: xyz_ArgTemp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP), intent(in ) :: xyz_ArgQH2OVap (0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(in ) :: xyz_ArgQH2OLiq(0:imax-1, 1:jmax, 1:kmax)
! Specific liquid water content
real(DP), intent(in ) :: xyz_ArgQH2OSol(0:imax-1, 1:jmax, 1:kmax)
! Specific ice content
real(DP), intent(in ) :: xyz_ArgU (0:imax-1,1:jmax,1:kmax)
! Zonal wind
real(DP), intent(in ) :: xyz_ArgV (0:imax-1,1:jmax,1:kmax)
! Meridional wind
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OVapDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OLiqDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DQH2OSolDt(0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DUDt (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xyz_DVDt (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ) :: xy_SurfRainFlux(0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP), intent(out ) :: xy_SurfSnowFlux(0:imax-1, 1:jmax)
! 降雪量.
! Snow
real(DP), intent(out ), optional :: xyz_MoistConvDetTend (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out ), optional :: xyz_MoistConvSubsidMassFlux(0:imax-1, 1:jmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! Temperature
real(DP) :: xyz_QH2OVap(0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP) :: xyz_QH2OLiq(0:imax-1, 1:jmax, 1:kmax)
! Specific liquid water content
real(DP) :: xyz_QH2OSol(0:imax-1, 1:jmax, 1:kmax)
! Specific ice content
real(DP) :: xyz_U (0:imax-1,1:jmax,1:kmax)
! Zonal wind
real(DP) :: xyz_V (0:imax-1,1:jmax,1:kmax)
! Meridional wind
real(DP) :: SurfTemp
! Pressure
real(DP) :: z_Press (1:kmax)
! Pressure
real(DP) :: r_Press (0:kmax)
! Pressure
real(DP) :: z_Exner (1:kmax)
! Exner function
real(DP) :: r_Exner (0:kmax)
! Exner function
real(DP) :: z_Temp (1:kmax)
! Temperature
real(DP) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP) :: z_QH2OLiq (1:kmax)
! Specific liquid water content
real(DP) :: z_QH2OSol (1:kmax)
! Specific ice content
real(DP) :: z_U (1:kmax)
! Zonal wind
real(DP) :: z_V (1:kmax)
! Meridional wind
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP) :: z_DTempDt (1:kmax)
real(DP) :: z_DQH2OVapDt(1:kmax)
real(DP) :: z_DQH2OLiqDt(1:kmax)
real(DP) :: z_DQH2OSolDt(1:kmax)
real(DP) :: z_DUDt (1:kmax)
real(DP) :: z_DVDt (1:kmax)
real(DP) :: SurfRainFlux
real(DP) :: SurfSnowFlux
real(DP) :: z_MoistConvDetTend (1:kmax)
real(DP) :: z_MoistConvSubsidMassFlux(1:kmax)
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_DelPress(0:imax-1, 1:jmax, 1:kmax)
! $ \Delta p $
!
real(DP) :: xyz_CWF (0:imax-1, 1:jmax, 1:kmax)
! Cloud work function
! (variable for output)
real(DP) :: xyz_DCWFDtLS (0:imax-1, 1:jmax, 1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
real(DP) :: xyz_CWFCrtl (0:imax-1, 1:jmax, 1:kmax)
! "Critical value" of cloud work function
real(DP) :: xyz_EntParam (0:imax-1, 1:jmax, 1:kmax)
! Entrainment factor (variable for output)
! Mass flux distribution function
real(DP) :: xyz_MassFluxDistFunc (0:imax-1, 1:jmax, 1:kmax)
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
character(STRING) :: VarName
real(DP) :: xyrz_CldTemp (0:imax-1, 1:jmax, 0:kmax, 1:kmax)
real(DP) :: xyrz_CldQH2OVap(0:imax-1, 1:jmax, 0:kmax, 1:kmax)
real(DP) :: xyrz_CldQH2OLiq(0:imax-1, 1:jmax, 0:kmax, 1:kmax)
real(DP) :: rz_CldTemp (0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OVap(0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OLiq(0:kmax, 1:kmax)
integer :: js
integer :: je
integer :: nthreads
integer, allocatable :: a_js(:)
integer, allocatable :: a_je(:)
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 :: l
!!$ integer :: m
integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
xyz_Temp = xyz_ArgTemp
xyz_QH2OVap = xyz_ArgQH2OVap
xyz_QH2OLiq = xyz_ArgQH2OLiq
xyz_QH2OSol = xyz_ArgQH2OSol
xyz_U = xyz_ArgU
xyz_V = xyz_ArgV
nthreads = 1
!$ nthreads = omp_get_max_threads()
!!$ !$ write( 6, * ) "Number of processors : ", omp_get_num_procs()
!!$ !$ write( 6, * ) "Number of threads : ", nthreads
allocate( a_js(0:nthreads-1) )
allocate( a_je(0:nthreads-1) )
do n = 0, nthreads-1
if ( n == 0 ) then
a_js(n) = 1
else
a_js(n) = a_je(n-1) + 1
end if
a_je(n) = a_js(n ) + jmax / nthreads - 1
if ( n + 1 <= mod( jmax, nthreads ) ) then
a_je(n) = a_je(n) + 1
end if
end do
!!$ !$OMP PARALLEL DEFAULT(PRIVATE) &
!!$ !$OMP SHARED( &
!!$ !$OMP nthreads, a_js, a_je, &
!!$ !$OMP imax, kmax, FlagEntCond, &
!!$ !$OMP xy_SurfTemp, xyz_Press, xyz_Exner, &
!!$ !$OMP xyz_Temp, xyz_QH2OVap, xyz_QH2OLiq, xyz_QH2OSol, &
!!$ !$OMP xyz_U, xyz_V, xyr_Press, xyr_Exner, &
!!$ !$OMP xyz_DTempDt, &
!!$ !$OMP xyz_DQH2OVapDt, xyz_DQH2OLiqDt, xyz_DQH2OSolDt, &
!!$ !$OMP xyz_DUDt, xyz_DVDt, &
!!$ !$OMP xy_SurfRainFlux, xy_SurfSnowFlux, &
!!$ !$OMP xyz_MoistConvDetTend, &
!!$ !$OMP xyz_MoistConvSubsidMassFlux, &
!!$ !$OMP xyrz_CldTemp, xyrz_CldQH2OVap, xyrz_CldQH2OLiq &
!!$ !$OMP )
!!$
!!$ !$OMP DO
do n = 0, nthreads-1
js = a_js(n)
je = a_je(n)
if ( js > je ) cycle
do j = js, je
do i = 0 , imax-1
SurfTemp = xy_SurfTemp(i,j)
do k = 1, kmax
z_Press (k) = xyz_Press (i,j,k)
z_Exner (k) = xyz_Exner (i,j,k)
z_Temp (k) = xyz_Temp (i,j,k)
z_QH2OVap(k) = xyz_QH2OVap(i,j,k)
z_QH2OLiq(k) = xyz_QH2OLiq(i,j,k)
z_QH2OSol(k) = xyz_QH2OSol(i,j,k)
z_U (k) = xyz_U (i,j,k)
z_V (k) = xyz_V (i,j,k)
end do
do k = 0, kmax
r_Press (k) = xyr_Press (i,j,k)
r_Exner (k) = xyr_Exner (i,j,k)
end do
if ( FlagEntCond ) then
call RASWithIce1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DTempDt, z_DQH2OVapDt, z_DQH2OLiqDt, z_DQH2OSolDt, z_DUDt, z_DVDt, SurfRainFlux, SurfSnowFlux, z_MoistConvDetTend, z_MoistConvSubsidMassFlux, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq )
else
call MessageNotify( 'E', module_name, 'Now, NoEntCond routine is not available, ' // 'since its interface has not been changed.' )
call RASWithIceNoEntCond1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQH2OLiqDt, z_DQH2OSolDt, SurfRainFlux, SurfSnowFlux, z_MoistConvDetTend, z_MoistConvSubsidMassFlux, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq )
end if
do k = 1, kmax
xyz_DTempDt (i,j,k) = z_DTempDt (k)
xyz_DQH2OVapDt(i,j,k) = z_DQH2OVapDt(k)
xyz_DQH2OLiqDt(i,j,k) = z_DQH2OLiqDt(k)
xyz_DQH2OSolDt(i,j,k) = z_DQH2OSolDt(k)
xyz_DUDt (i,j,k) = z_DUDt (k)
xyz_DVDt (i,j,k) = z_DVDt (k)
end do
xy_SurfRainFlux(i,j) = SurfRainFlux
xy_SurfSnowFlux(i,j) = SurfSnowFlux
if ( present( xyz_MoistConvDetTend ) ) then
do k = 1, kmax
xyz_MoistConvDetTend(i,j,k) = z_MoistConvDetTend(k)
end do
end if
if ( present( xyz_MoistConvSubsidMassFlux ) ) then
do k = 1, kmax
xyz_MoistConvSubsidMassFlux(i,j,k) = z_MoistConvSubsidMassFlux(k)
end do
end if
do l = 1, kmax
do k = 0, kmax
xyrz_CldTemp (i,j,k,l) = rz_CldTemp (k,l)
xyrz_CldQH2OVap(i,j,k,l) = rz_CldQH2OVap(k,l)
xyrz_CldQH2OLiq(i,j,k,l) = rz_CldQH2OLiq(k,l)
end do
end do
end do
end do
end do
!!$ !$OMP END DO
!!$ !$OMP END PARALLEL
deallocate( a_js )
deallocate( a_je )
! calculation for output
do k = 1, kmax
xyz_DelPress(:,:,k) = xyr_Press(:,:,k-1) - xyr_Press(:,:,k)
end do
xyz_DTempDtCumulus = xyz_DTempDt
xyz_DQVapDtCumulus = xyz_DQH2OVapDt
xy_RainCumulus = xy_SurfRainFlux + xy_SurfSnowFlux
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'RainCumulus' , xy_RainCumulus * LatentHeat )
call HistoryAutoPut( TimeN, 'DTempDtCumulus' , xyz_DTempDtCumulus )
call HistoryAutoPut( TimeN, 'DQH2OVapDtCumulus' , xyz_DQVapDtCumulus )
call HistoryAutoPut( TimeN, 'DQH2OLiqDtCumulus' , xyz_DQH2OLiqDt )
call HistoryAutoPut( TimeN, 'DQH2OSolDtCumulus' , xyz_DQH2OSolDt )
call HistoryAutoPut( TimeN, 'RASMassFluxDistFunc', xyz_MassFluxDistFunc )
call HistoryAutoPut( TimeN, 'RASEntParam' , xyz_EntParam )
call HistoryAutoPut( TimeN, 'RASCWF' , xyz_CWF )
call HistoryAutoPut( TimeN, 'RASCWFCrtl' , xyz_CWFCrtl )
call HistoryAutoPut( TimeN, 'RASDCWFDtLS' , xyz_DCWFDtLS )
!!$ call HistoryAutoPut( TimeN, 'RASMixLayTopIndex' , real( xy_IndexMixLayTop ) )
do l = 1, kmax
do k = 0, kmax
do j = 1, jmax
do i = 0, imax-1
if ( xyrz_CldTemp (i,j,k,l) == 1.0d100 ) xyrz_CldTemp (i,j,k,l) = 0.0_DP
if ( xyrz_CldQH2OVap(i,j,k,l) == 1.0d100 ) xyrz_CldQH2OVap(i,j,k,l) = 0.0_DP
if ( xyrz_CldQH2OLiq(i,j,k,l) == 1.0d100 ) xyrz_CldQH2OLiq(i,j,k,l) = 0.0_DP
end do
end do
end do
end do
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine RASWithIce1DWrapper3D
| Subroutine : | |
| IndexMixLayTop : | integer , intent(in ) |
| r_Press( 0:kmax ) : | real(DP), intent(in ) |
| z_Press( 1:kmax ) : | real(DP), intent(in ) |
| z_DQRainDt( 1:kmax ) : | real(DP), intent(in ) |
| z_DQSnowDt( 1:kmax ) : | real(DP), intent(in ) |
| z_Temp( 1:kmax ) : | real(DP), intent(inout) |
| z_QH2OVap( 1:kmax ) : | real(DP), intent(inout) |
| SurfRainFlux : | real(DP), intent(out ) |
| SurfSnowFlux : | real(DP), intent(out ) |
subroutine RASWithIceCalcPRCPStepPC1D( IndexMixLayTop, r_Press, z_Press, z_DQRainDt, z_DQSnowDt, z_Temp, z_QH2OVap, SurfRainFlux, SurfSnowFlux )
! 時刻管理
! Time control
!
use timeset, only: DelTime ! $ \Delta t $ [s]
! 物理定数設定
! Physical constants settings
!
use constants, only: CpDry, Grav, LatentHeat, LatentHeatFusion, EpsV
! $ \epsilon_v $ .
! 水蒸気分子量比.
! Molecular weight of water vapor
! 雲関系ルーチン
! Cloud-related routines
!
use cloud_utils, only : CloudUtilsPRCPStepPC1Grid, CloudUtilsPRCPEvap1Grid
! 雪と海氷の定数の設定
! Setting constants of snow and sea ice
!
use constants_snowseaice, only: TempCondWater
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(in ) :: r_Press ( 0:kmax )
real(DP), intent(in ) :: z_Press ( 1:kmax )
real(DP), intent(in ) :: z_DQRainDt ( 1:kmax )
real(DP), intent(in ) :: z_DQSnowDt ( 1:kmax )
real(DP), intent(inout) :: z_Temp ( 1:kmax )
real(DP), intent(inout) :: z_QH2OVap ( 1:kmax )
real(DP), intent(out ) :: SurfRainFlux
real(DP), intent(out ) :: SurfSnowFlux
! 作業変数
! Work variables
!
real(DP) :: z_DelMass( 1:kmax )
real(DP) :: MassMaxFreezeRate
real(DP) :: MassFreezeRate
real(DP) :: MassMaxMeltRate
real(DP) :: MassMeltRate
real(DP) :: VirTemp
real(DP) :: aaa_TempTMP (1,1,1)
real(DP) :: aaa_PressTMP(1,1,1)
real(DP) :: aaa_QH2OVapSat(1,1,1)
real(DP) :: QH2OVapSat
real(DP) :: PRCPFlux
real(DP) :: DelPRCPFlux
real(DP) :: DelQH2OVap
real(DP) :: LatentHeatLocal
character(STRING) :: CharPhase
integer :: i
integer :: j
integer :: k
integer :: l
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
do k = 1, kmax
z_DelMass(k) = ( r_Press(k-1) - r_Press(k) ) / Grav
end do
! Freezing and melting switching at temperature of TempCondWater
SurfRainFlux = 0.0_DP
SurfSnowFlux = 0.0_DP
do k = kmax, 1, -1
! Freezing/melting of precipitation
call CloudUtilsPRCPStepPC1Grid( r_Press(k-1), r_Press(k), z_Temp(k), SurfRainFlux, SurfSnowFlux )
! Evaporation occur below clouds
if ( k <= IndexMixLayTop ) then
call CloudUtilsPRCPEvap1Grid( z_Press(k), r_Press(k-1), r_Press(k), PRCPArea, PRCPEvapArea, z_Temp(k), z_QH2OVap(k), SurfRainFlux, SurfSnowFlux )
end if
SurfRainFlux = SurfRainFlux + z_DQRainDt(k) * z_DelMass(k)
SurfSnowFlux = SurfSnowFlux + z_DQSnowDt(k) * z_DelMass(k)
end do
end subroutine RASWithIceCalcPRCPStepPC1D
| Subroutine : | |||
| SurfTemp : | real(DP), intent(in )
| ||
| z_Press(1:kmax) : | real(DP), intent(in )
| ||
| r_Press(0:kmax) : | real(DP), intent(in )
| ||
| z_Exner(1:kmax) : | real(DP), intent(in )
| ||
| r_Exner(0:kmax) : | real(DP), intent(in )
| ||
| z_Temp(1:kmax) : | real(DP), intent(inout)
| ||
| z_QH2OVap(1:kmax) : | real(DP), intent(inout)
| ||
| z_QH2OLiq(1:kmax) : | real(DP), intent(inout)
| ||
| z_QH2OSol(1:kmax) : | real(DP), intent(inout)
| ||
| z_U(1:kmax) : | real(DP), intent(inout) | ||
| z_V(1:kmax) : | real(DP), intent(inout) | ||
| z_DQH2OLiqDt(1:kmax) : | real(DP), intent(out ) | ||
| z_DQH2OSolDt(1:kmax) : | real(DP), intent(out ) | ||
| SurfRainFlux : | real(DP), intent(out )
| ||
| SurfSnowFlux : | real(DP), intent(out )
| ||
| z_MoistConvDetTend(1:kmax) : | real(DP), intent(out ), optional | ||
| z_MoistConvSubsidMassFlux(1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldTemp(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OVap(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OLiq(0:kmax, 1:kmax) : | real(DP), intent(out ), optional | ||
| rz_CldQH2OSol(0:kmax, 1:kmax) : | real(DP), intent(out ), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIceNoEntCond1D( SurfTemp, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQH2OLiqDt, z_DQH2OSolDt, SurfRainFlux, SurfSnowFlux, z_MoistConvDetTend, z_MoistConvSubsidMassFlux, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 宣言文 ; Declaration statements
!
real(DP), intent(in ) :: SurfTemp
! Pressure
real(DP), intent(in ) :: z_Press (1:kmax)
! Pressure
real(DP), intent(in ) :: r_Press (0:kmax)
! Pressure
real(DP), intent(in ) :: z_Exner (1:kmax)
! Exner function
real(DP), intent(in ) :: r_Exner (0:kmax)
! Exner function
real(DP), intent(inout) :: z_Temp (1:kmax)
! Temperature
real(DP), intent(inout) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(inout) :: z_QH2OLiq(1:kmax)
! Specific liquid water content
real(DP), intent(inout) :: z_QH2OSol(1:kmax)
! Specific ice content
real(DP), intent(inout) :: z_U(1:kmax)
real(DP), intent(inout) :: z_V(1:kmax)
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: z_DQH2OLiqDt(1:kmax)
real(DP), intent(out ) :: z_DQH2OSolDt(1:kmax)
real(DP), intent(out ) :: SurfRainFlux
! 降水量.
! Precipitation
real(DP), intent(out ) :: SurfSnowFlux
! 降雪量.
! Snow
real(DP), intent(out ), optional :: z_MoistConvDetTend (1:kmax)
real(DP), intent(out ), optional :: z_MoistConvSubsidMassFlux(1:kmax)
real(DP), intent(out ), optional :: rz_CldTemp (0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OVap(0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OLiq(0:kmax, 1:kmax)
real(DP), intent(out ), optional :: rz_CldQH2OSol(0:kmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_Height (1:kmax)
!
! Height
real(DP) :: r_Height (0:kmax)
!
! Height
real(DP) :: z_DTempDtCumulus (1:kmax)
! 温度変化率.
! Temperature tendency
real(DP) :: z_DQVapDtCumulus (1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP) :: z_PotTemp (1:kmax)
! Potential temperature
!
!!$ real(DP) :: z_QH2OVapSat(1:kmax)
!!$ ! 飽和比湿.
!!$ ! Saturation specific humidity.
!!$ ! Dry and moist static energy in environment (Env) and cloud (Cld)
!!$ !
!!$ real(DP) :: z_EnvDryStaticEne (1:kmax)
!!$ real(DP) :: r_EnvDryStaticEne (0:kmax)
!!$ real(DP) :: z_EnvMoistStaticEne (1:kmax)
!!$ real(DP) :: r_EnvMoistStaticEne (0:kmax)
!!$ real(DP) :: z_EnvMoistStaticEneSat(1:kmax)
!!$ real(DP) :: r_EnvMoistStaticEneSat(0:kmax)
!!$
!!$ real(DP) :: z_EnvCondStaticEne (1:kmax)
!!$
!!$ real(DP) :: r_CldMoistStaticEne (0:kmax)
!!$ real(DP) :: r_CldCondStaticEne (0:kmax)
!!$
!!$ real(DP) :: CldCondStaticEneCldTop
real(DP) :: Kernel
! Tendency of cloud work function by cumulus convection, kernel
real(DP) :: CWF
! Cloud work function
real(DP) :: z_CWF(1:kmax)
! Cloud work function
! (variable for output)
real(DP) :: DCWFDtLS
! Tendency of cloud work function by large scale motion
real(DP) :: z_DCWFDtLS(1:kmax)
! Tendency of cloud work function by large scale motion
! (variable for output)
real(DP) :: CldMassFluxBottom
! Cloud mass flux at cloud bottom
real(DP) :: z_Beta (1:kmax)
real(DP) :: z_BetaCldTop (1:kmax)
real(DP) :: z_Gamma (1:kmax)
real(DP) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
!!$ real(DP) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP) :: z_GammaQH2OVap (1:kmax)
! Tendency of water vapor per unit mass flux
real(DP) :: z_GammaQH2OLiq (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP) :: z_GammaQH2OSol (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP) :: z_GammaQRain (1:kmax)
! Tendency of rain per unit mass flux
real(DP) :: z_GammaQSnow (1:kmax)
! Tendency of snow per unit mass flux
real(DP) :: z_GammaU (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP) :: z_GammaV (1:kmax)
! Tendency of meridional wind per unit mass flux
!!$ real(DP) :: zf_GammaQOthers (1:kmax,1:ncmax)
!!$ ! Tendency of passive constituents per unit mass flux
real(DP) :: z_Mu (1:kmax)
real(DP) :: z_Eps (1:kmax)
real(DP) :: PressCldBase
! Pressure of cloud base
real(DP) :: z_CWFCrtl (1:kmax)
! "Critical value" of cloud work function
real(DP) :: z_DetCldWatCondFactor (1:kmax)
real(DP) :: z_DetCldIceCondFactor (1:kmax)
real(DP) :: EntParam
! Entrainment factor
real(DP) :: z_EntParam (1:kmax)
! Entrainment factor (variable for output)
!!$ real(DP) :: EntParamLL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! higher level
!!$ real(DP) :: EntParamUL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! lower level
! Difference of normalized mass flux between layer interface
real(DP) :: z_DelNormMassFlux (1:kmax)
real(DP) :: DelNormMassFluxCldTop
! Normalized mass flux at layer interface and cloud top
real(DP) :: r_NormMassFlux (0:kmax)
real(DP) :: NormMassFluxCldTop
!!$ ! cloud total water
!!$ real(DP) :: r_CldQH2OTot(0:kmax)
!!$ ! cloud total water at cloud top
!!$ real(DP) :: CldQH2OTotCldTop
!!$ ! cloud condensate at cloud top
!!$ real(DP) :: CldQH2OCondCldTop
! cloud water at cloud top
real(DP) :: CldQH2OLiqCldTop
! cloud ice at cloud top
real(DP) :: CldQH2OSolCldTop
! Mass flux distribution function
real(DP) :: z_MassFluxDistFunc (1:kmax)
!!$ real(DP) :: z_DelH2OMass (1:kmax)
!!$ real(DP) :: H2OMassB
!!$ real(DP) :: H2OMassA
!!$ real(DP) :: NegDDelLWDt
!!$ real(DP) :: z_DDelLWDtCCPLV(1:kmax)
!!$ logical :: FlagCrossSatEquivPotTemp
!!$ !
!!$ ! Flag showing whether a parcel in cloud has moist static
!!$ ! energy larger than environment's
real(DP) :: r_QH2OVapSat (0:kmax)
real(DP) :: r_TempAdiabAscent (0:kmax)
real(DP) :: SurfPotTemp
!!$ real(DP) :: xyz_TempAdiabAscent (0:imax-1, 1:jmax, 1:kmax)
! Variables for looking for top of mixed layer
!
logical :: FlagMixLayTopFound
integer :: IndexMixLayTop
! Variables for modification of cloud mass flux
!
!!$ real(DP) :: z_QH2OVapTentative (1:kmax)
!!$ real(DP) :: CldMassFluxCorFactor
!!$ real(DP) :: CldMassFluxCorFactorTentative
real(DP) :: z_TempB (1:kmax)
! 調節前の温度.
! Temperature before adjustment
real(DP) :: z_QH2OVapB(1:kmax)
! 調節前の比湿.
! Specific humidity before adjustment
real(DP) :: z_QH2OLiqB(1:kmax)
!
! Specific liquid water content before adjustment
real(DP) :: z_QH2OSolB(1:kmax)
!
! Specific liquid water content before adjustment
real(DP) :: z_UB (1:kmax)
!
! Zonal wind before adjustment
real(DP) :: z_VB (1:kmax)
!
! Meridional wind before adjustment
! Flags for modification of
!
logical :: FlagKernelNegative
logical :: FlagNegH2OCondCldTop
! Variables for subsidence mass flux between updrafts
!
real(DP) :: DelNormMassFluxHalfLayer
real(DP) :: NormMassFlux
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
!!$ real(DP) :: CldTempB
!!$ real(DP) :: a_DQVapSatDTemp(1:1)
!!$ real(DP) :: DelTemp
real(DP) :: r_CldTemp (0:kmax)
real(DP) :: r_CldQH2OVap(0:kmax)
real(DP) :: r_CldQH2OLiq(0:kmax)
real(DP) :: r_CldQH2OSol(0:kmax)
!!$ real(DP) :: r_CldHeight (0:kmax)
real(DP) :: SumTmp
real(DP) :: z_TempTMP (1:kmax)
real(DP) :: z_QH2OVapTMP(1:kmax)
real(DP) :: z_QH2OLiqTMP(1:kmax)
real(DP) :: z_QH2OSolTMP(1:kmax)
real(DP) :: z_UTMP(1:kmax)
real(DP) :: z_VTMP(1:kmax)
real(DP) :: z_DQRainDtTMP(1:kmax)
real(DP) :: z_DQSnowDtTMP(1:kmax)
real(DP) :: z_PotTempTMP(1:kmax)
real(DP) :: z_DelNormMassFluxTMP(1:kmax)
real(DP) :: DelNormMassFluxCldTopTMP
real(DP) :: r_NormMassFluxTMP(0:kmax)
real(DP) :: NormMassFluxCldTopTMP
real(DP) :: CldQH2OLiqCldTopTMP
real(DP) :: CldQH2OSolCldTopTMP
real(DP) :: CWFTMP
real(DP) :: EntParamTMP
real(DP) :: z_MuTMP(1:kmax)
real(DP) :: z_EpsTMP(1:kmax)
real(DP) :: z_GammaTMP(1:kmax)
real(DP) :: z_GammaDSETMP(1:kmax)
!!$ real(DP) :: z_GammaMSETMP(1:kmax)
real(DP) :: z_GammaQH2OVapTMP(1:kmax)
real(DP) :: z_GammaQH2OLiqTMP(1:kmax)
real(DP) :: z_GammaQH2OSolTMP(1:kmax)
real(DP) :: z_GammaQRainTMP (1:kmax)
real(DP) :: z_GammaQSnowTMP (1:kmax)
real(DP) :: z_GammaUTMP (1:kmax)
real(DP) :: z_GammaVTMP (1:kmax)
!!$ real(DP) :: zf_GammaQOthersTMP(1:kmax,1:ncmax)
logical :: FlagEntParamOrderInapp
logical :: FlagEntParamOrderInappTMP
logical :: FlagNegH2OCondCldTopTMP
real(DP) :: rz_CldTempTMP (0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OVapTMP(0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OLiqTMP(0:kmax, 1:kmax)
real(DP) :: rz_CldQH2OSolTMP(0:kmax, 1:kmax)
real(DP) :: z_DQRainDt (1:kmax)
real(DP) :: z_DQSnowDt (1:kmax)
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer :: l
!!$ integer :: m
!!$ integer :: n
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
! Temporal
!!$ z_QH2OLiq = 0.0_DP
!!$ z_QH2OSol = 0.0_DP
! 調節前 "Temp", "QH2OVap" の保存
! Store "Temp", "QH2OVap" before adjustment
!
z_TempB = z_Temp
z_QH2OVapB = z_QH2OVap
z_QH2OLiqB = z_QH2OLiq
z_QH2OSolB = z_QH2OSol
z_UB = z_U
z_VB = z_V
! Preparation of variables
!
!
! Auxiliary variables
! Pressure difference between upper and lower interface of the layer
do k = 1, kmax
z_DelPress(k) = r_Press(k-1) - r_Press(k)
end do
! beta
do k = 1, kmax
z_Beta(k) = CpDry / Grav * ( r_Exner(k-1) - r_Exner(k) )
end do
do k = 1, kmax
z_BetaCldTop(k) = CpDry / Grav * ( r_Exner(k-1) - z_Exner(k) )
end do
!
! Search for top of mixed layer (lifting condensation level) based on
! a description in p.684 of Arakawa and Shubert (1974).
!
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
!
!====================================
!
!!$ xyz_TempAdiabAscent(:,:,1) = xyz_Temp(:,:,1)
!!$ do k = 2, kmax
!!$ xyz_TempAdiabAscent(:,:,k) = &
!!$ & xyz_Temp(:,:,1) - Grav / CpDry * ( xyz_Height(:,:,k) - xyz_Height(:,:,1) )
!!$ end do
!!$ xyz_TempAdiabAscent = max( xyz_TempAdiabAscent, 1.0_DP )
!!$ xyz_QH2OVapSat = xyz_CalcQVapSat( xyz_TempAdiabAscent, xyz_Press )
!!$ xy_IndexMixLayTop = 1
!!$ xy_FlagMixLayTopFound = .false.
!!$ do k = 2, kmax
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( ( xyz_QH2OVap(i,j,1) >= xyz_QH2OVapSat(i,j,k) ) .and. &
!!$ & ( .not. xy_FlagMixLayTopFound(i,j) ) ) then
!!$ xy_IndexMixLayTop (i,j) = k - 1
!!$ xy_FlagMixLayTopFound(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!
!------------------------------------
!
!!$ xyr_TempAdiabAscent(:,:,0) = xy_SurfTemp
!!$ do k = 1, kmax
!!$ xyr_TempAdiabAscent(:,:,k) = &
!!$ & xy_SurfTemp - Grav / CpDry * ( xyr_Height(:,:,k) - 0.0_DP )
!!$ end do
!!$ xyr_TempAdiabAscent = max( xyr_TempAdiabAscent, 1.0_DP )
!!$
r_TempAdiabAscent(0) = SurfTemp
SurfPotTemp = SurfTemp / r_Exner(0)
do k = 1, kmax
r_TempAdiabAscent(k) = SurfPotTemp * r_Exner(k)
end do
!
r_QH2OVapSat(0 ) = 1.0d100
r_QH2OVapSat(1:kmax-1) = a_CalcQVapSat( r_TempAdiabAscent(1:kmax-1), r_Press(1:kmax-1) )
r_QH2OVapSat(kmax ) = r_QH2OVapSat(kmax-1)
!
IndexMixLayTop = 1
FlagMixLayTopFound = .false.
do k = 2, kmax
if ( ( z_QH2OVap(1) >= r_QH2OVapSat(k) ) .and. ( .not. FlagMixLayTopFound ) ) then
IndexMixLayTop = k - 1
FlagMixLayTopFound = .true.
end if
end do
!
!====================================
!
if ( .not. FlagMixLayTopFound ) then
IndexMixLayTop = kmax - 1
end if
!
! Critical cloud work function
!
if ( FlagZeroCrtlCWF ) then
z_CWFCrtl = 0.0_DP
else
PressCldBase = r_Press(IndexMixLayTop)
call ASL1982CalcCWFCrtl1D( PressCldBase, z_Press, z_CWFCrtl )
end if
!
! Rain conversion factor
!
if ( DetCldWatCondFactor0 < 0.0_DP ) then
do k = 1, kmax
if ( z_Press(k) < 500.0d2 ) then
z_DetCldWatCondFactor(k) = 1.0_DP
else if ( z_Press(k) < 800.0d2 ) then
z_DetCldWatCondFactor(k) = 0.8_DP + ( 800.0d2 - z_Press(k) ) / 1500.0d2
else
z_DetCldWatCondFactor(k) = 0.8_DP
end if
end do
else
z_DetCldWatCondFactor = DetCldWatCondFactor0
end if
!
! Snow/Ice conversion factor
!
if ( DetCldIceCondFactor0 < 0.0_DP ) then
do k = 1, kmax
if ( z_Press(k) < 500.0d2 ) then
z_DetCldIceCondFactor(k) = 1.0_DP
else if ( z_Press(k) < 800.0d2 ) then
z_DetCldIceCondFactor(k) = 0.8_DP + ( 800.0d2 - z_Press(k) ) / 1500.0d2
else
z_DetCldIceCondFactor(k) = 0.8_DP
end if
end do
else
z_DetCldIceCondFactor = DetCldIceCondFactor0
end if
z_EntParam (1) = 0.0_DP
z_CWF (1) = 0.0_DP
z_DCWFDtLS (1) = 0.0_DP
z_MassFluxDistFunc(1) = 0.0_DP
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(1) = 0.0_DP
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
! Initialization
!
z_MoistConvSubsidMassFlux = 0.0_DP
end if
r_CldTemp = 1.0d100
r_CldQH2OVap = 1.0d100
r_CldQH2OLiq = 1.0d100
r_CldQH2OSol = 1.0d100
l = 1
if ( present( rz_CldTemp ) ) rz_CldTemp (:,l) = r_CldTemp
if ( present( rz_CldQH2OVap ) ) rz_CldQH2OVap(:,l) = r_CldQH2OVap
if ( present( rz_CldQH2OLiq ) ) rz_CldQH2OLiq(:,l) = r_CldQH2OLiq
if ( present( rz_CldQH2OSol ) ) rz_CldQH2OSol(:,l) = r_CldQH2OSol
z_DQRainDt(l) = 0.0_DP
z_DQSnowDt(l) = 0.0_DP
loop_cloud_top : do l = 2, kmax
call RASWithIceNoEntCond1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTemp, z_DelNormMassFlux, DelNormMassFluxCldTop, r_NormMassFlux, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, CWF, EntParam, z_Mu, z_Eps, z_Gamma, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, FlagEntParamOrderInapp, FlagNegH2OCondCldTop, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
! Time derivative of cloud work function by large scale motion
!
DCWFDtLS = ( CWF - z_CWFCrtl(l) ) / ( 2.0_DP * DelTime )
! for output
z_EntParam(l) = EntParam
! for save
z_CWF(l) = CWF
! for save
z_DCWFDtLS(l) = DCWFDtLS
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQRainDt(l), z_DQSnowDt(l) )
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(l) = 0.0_DP
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
do k = 1, l-1
if ( k > IndexMixLayTop ) then
z_MoistConvSubsidMassFlux(k) = 0.0_DP
end if
end do
end if
else
!-------------------------------------------------
! Calculation of kernel, tendency of cloud work function by cumulus
! convection per unit mass flux
!
! arbitrary small value is set for trial
!!$ CldMassFluxBottom = 1.0d0
! This value is empirically determined. Pressure dependence is
! introduced simply for future use.
!!$ CldMassFluxBottom = 1.0d-1 * r_Press(IndexMixLayTop) / 1.0d5
CldMassFluxBottom = 1.0d-3 * r_Press(IndexMixLayTop) / 1.0d5
! mass flux is zero if entrainment order is inappropriate
if ( FlagEntParamOrderInapp ) then
CldMassFluxBottom = 0.0_DP
end if
! mass flux is zero if liquid water at a cloud top is negative
if ( FlagNegH2OCondCldTop ) then
CldMassFluxBottom = 0.0_DP
end if
! mass flux has to be zero or positive
CldMassFluxBottom = max( CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
end if
! modify cloud mass flux
call RASWithIce1DModMassFlux( z_QH2OVap, z_GammaQH2OVap, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OLiq, z_GammaQH2OLiq, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OSol, z_GammaQH2OSol, CldMassFluxBottom )
! update field by cumulus convection
z_TempTMP = z_Temp
z_QH2OVapTMP = z_QH2OVap
z_QH2OLiqTMP = z_QH2OLiq
z_QH2OSolTMP = z_QH2OSol
z_UTMP = z_U
z_VTMP = z_V
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_TempTMP, z_QH2OVapTMP, z_QH2OLiqTMP, z_QH2OSolTMP, z_UTMP, z_VTMP, z_DQRainDtTMP(l), z_DQSnowDtTMP(l) )
! calculation of cloud work function in a updated field
call RASWithIceNoEntCond1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_TempTMP, z_QH2OVapTMP, z_QH2OLiqTMP, z_QH2OSolTMP, z_UTMP, z_VTMP, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTempTMP, z_DelNormMassFluxTMP, DelNormMassFluxCldTopTMP, r_NormMassFluxTMP, NormMassFluxCldTopTMP, CldQH2OLiqCldTopTMP, CldQH2OSolCldTopTMP, CWFTMP, EntParamTMP, z_MuTMP, z_EpsTMP, z_GammaTMP, z_GammaDSETMP, z_GammaQH2OVapTMP, z_GammaQH2OLiqTMP, z_GammaQH2OSolTMP, z_GammaQRainTMP(l), z_GammaQSnowTMP(l), z_GammaUTMP, z_GammaVTMP, FlagEntParamOrderInappTMP, FlagNegH2OCondCldTopTMP, rz_CldTempTMP, rz_CldQH2OVapTMP, rz_CldQH2OLiqTMP, rz_CldQH2OSolTMP )
! calculation of kernel
Kernel = ( CWFTMP - CWF ) / ( 2.0_DP * DelTime ) / ( CldMassFluxBottom + 1.0d-100 )
!-------------------------------------------------
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ ! TEST RUN BY THE USE OF RAS METHOD FOR KERNEL CALCULATION
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$
!!$ z_GammaMSE = z_GammaDSE + LatentHeat * z_GammaQH2OVap
!!$
!!$ ! This is a method by RAS.
!!$ !
!!$ ! Kernel, time derivative of cloud work function by cumulus convection
!!$ ! per unit mass flux
!!$ !
!!$ Kernel = &
!!$ & z_Eps(IndexMixLayTop+1) &
!!$ & * z_GammaMSE(IndexMixLayTop) &
!!$ & - z_Eps(l) * r_NormMassFlux(l-1) &
!!$ & * ( 1.0_DP + z_Gamma(l) ) &
!!$ & * z_GammaDSE(l)
!!$ do n = IndexMixLayTop+1, l-1
!!$ SumTmp = 0.0_DP
!!$ do m = IndexMixLayTop+1, n
!!$ SumTmp = SumTmp &
!!$ & + z_DelNormMassFlux(m) * z_GammaMSE(m)
!!$ end do
!!$ Kernel = Kernel &
!!$ & + ( z_Eps(n+1) + z_Mu(n) ) &
!!$ & * ( z_GammaMSE(IndexMixLayTop) - SumTmp ) &
!!$ & - ( z_Eps(n) * r_NormMassFlux(n-1) &
!!$ & + z_Mu (n) * r_NormMassFlux(n ) ) &
!!$ & * ( 1.0_DP + z_Gamma(n) ) * z_GammaDSE(n)
!!$ end do
!!$
!!$ !**********************************************************************
!!$ !**********************************************************************
!!$ !**********************************************************************
! Check whether kernel is positive or negative.
!
if ( Kernel < 0.0_DP ) then
FlagKernelNegative = .true.
else
FlagKernelNegative = .false.
end if
! Load et al. (1982), p.108
Kernel = min( Kernel, -5.0d-3 )
! Cloud mass flux at cloud bottom
!
CldMassFluxBottom = - DCWFDtLS / Kernel
!
! mass flux has to be zero or positive
CldMassFluxBottom = max( CldMassFluxBottom, 0.0_DP )
! mass flux is zero if entrainment parameter is zero or negative
if ( EntParam <= 0.0_DP ) then
CldMassFluxBottom = 0.0_DP
end if
!!$ ! mass flux is zero if it is below lifting condensation level
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( .not. xy_FlagCrossSatEquivPotTemp(i,j) ) then
!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!$ end if
!!$ end do
!!$ end do
! mass flux is zero if the LNB is unstable for updrafts
! (i.e., if the parcel is positively buoyant just above the LNB).
! See Lord et al. (1982), p.112, for more details.
! Strictly speaking, the process below is different from that
! proposed by Lord et al. (1982). Lord et al. (1982) compare
! entrainment parameters at 3 levels. But, entrainment
! parameters at 2 levels are compared below, because comparison
! of values between 2 levels seems to be sufficient.
!!!$ if ( ( 3 <= l ) .and. ( l <= kmax-1 ) ) then
!!!$ do j = 1, jmax
!!!$ do i = 0, imax-1
!!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!!$ end if
!!!$ end if
!!!$ end do
!!!$ end do
!!!$ end if
!!!$ if ( xy_IndexMixLayTop(i,j) == l ) then
!!!$ if ( ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ if ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) then
!!!$ xy_CloudMassFluxBottom(i,j) = 0.0_DP
!!!$ end if
!!!$ end if
!!!$ else if ( ( xy_IndexMixLayTop(i,j) < l ) .and. ( l <= kmax-1 ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParam (i,j) > 0.0_DP ) .and. &
!!!$ & ( xy_EntParamUL(i,j) > 0.0_DP ) ) then
!!!$ if ( ( xy_EntParamLL(i,j) < xy_EntParam (i,j) ) .and. &
!!!$ & ( xy_EntParam (i,j) < xy_EntParamUL(i,j) ) ) then
!
! This was used in a version without ice.
! But, now, lines below are commented out, because EntParamUL is not
! set. (2014/02/02)
! This is done below by the use of FlagEntParamOrderInapp.
!
!!$ if ( ( IndexMixLayTop <= l ) .and. ( l <= kmax-1 ) ) then
!!$ if ( ( EntParam > 0.0_DP ) .and. &
!!$ & ( EntParamUL > 0.0_DP ) ) then
!!$ if ( EntParam < EntParamUL ) then
!!$ CldMassFluxBottom = 0.0_DP
!!$ end if
!!$ end if
!!$ end if
!
! mass flux is zero if entrainment order is inappropriate
!
if ( FlagEntParamOrderInapp ) then
CldMassFluxBottom = 0.0_DP
end if
!
! mass flux is zero unless kernel is negative
!
if ( .not. FlagKernelNegative ) then
CldMassFluxBottom = 0.0_DP
end if
!
! mass flux is zero if liquid water at a cloud top is negative
!
if ( FlagNegH2OCondCldTop ) then
CldMassFluxBottom = 0.0_DP
end if
!
! multiply factor
!
CldMassFluxBottom = CldMassFluxBottom * min( 2.0_DP * DelTime / AdjTimeConst, 1.0_DP )
!
! for output
z_MassFluxDistFunc(l) = CldMassFluxBottom
! Check values of cloud mass flux
! If water vapor amount transported by convection is larger than that in a
! column, cloud mass flux is reduced.
!
! tendency of specific humidity is calculated tentatively
!!$ z_DQVapDtCumulus = &
!!$ & + CldMassFluxBottom * ( z_GammaMSE - z_GammaDSE ) &
!!$ & / LatentHeat
!!$ ! total H2O mass in a vertical column after RAS
!!$ z_QH2OVapTentative = z_QH2OVap + z_DQVapDtCumulus * 2.0_DP * DelTime
!!$ CldMassFluxCorFactor = 1.0_DP
!!$ do k = 1, kmax
!!$ if ( z_QH2OVapTentative(k) < 0.0_DP ) then
!!$ CldMassFluxCorFactorTentative = z_QH2OVap(k) &
!!$ & / ( z_QH2OVap(k) - z_QH2OVapTentative(k) )
!!$ else
!!$ CldMassFluxCorFactorTentative = 1.0_DP
!!$ end if
!!$ if ( CldMassFluxCorFactorTentative < CldMassFluxCorFactor ) then
!!$ CldMassFluxCorFactor = CldMassFluxCorFactorTentative
!!$ end if
!!$ end do
!!$ ! modify cloud mass flux
!!$ CldMassFluxBottom = CldMassFluxCorFactor * CldMassFluxBottom
call RASWithIce1DModMassFlux( z_QH2OVap, z_GammaQH2OVap, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OLiq, z_GammaQH2OLiq, CldMassFluxBottom )
call RASWithIce1DModMassFlux( z_QH2OSol, z_GammaQH2OSol, CldMassFluxBottom )
!!$ do k = 1, kmax
!!$ xyz_DQVapDtCumulus(:,:,k) = &
!!$ & + xy_CloudMassFluxBottom * ( xyz_GammaMSE(:,:,k) - xyz_GammaDSE(:,:,k) ) &
!!$ & / LatentHeat
!!$ end do
!!$ ! total H2O mass in a vertical column before RAS
!!$ xyz_DelH2OMass = xyz_QH2OVap * xyz_DelPress / Grav
!!$ xy_H2OMassB = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassB = xy_H2OMassB + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! total H2O mass in a vertical column after RAS
!!$ xyz_QH2OVapTentative = xyz_QH2OVap + xyz_DQVapDtCumulus * 2.0_DP * DelTime
!!$ xyz_DelH2OMass = xyz_QH2OVapTentative * xyz_DelPress / Grav
!!$ xy_H2OMassA = 0.0_DP
!!$ do k = kmax, 1, -1
!!$ xy_H2OMassA = xy_H2OMassA + xyz_DelH2OMass(:,:,k)
!!$ end do
!!$ ! modify cloud mass flux
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ if ( xy_H2OMassA(i,j) < 0.0_DP ) then
!!$ ! A safety factor ( 1.0_DP + 1.0d-5 ) is arbitrary.
!!$ xy_CloudMassFluxBottom(i,j) = xy_CloudMassFluxBottom(i,j) &
!!$ & * xy_H2OMassB(i,j) &
!!$ & / ( ( xy_H2OMassB(i,j) - xy_H2OMassA(i,j) ) * ( 1.0_DP + 1.0d-5 ) )
!!$ end if
!!$ end do
!!$ end do
call RASWithIce1DCore02( l, z_DelPress, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, z_GammaQRain(l), z_GammaQSnow(l), z_GammaU, z_GammaV, CldMassFluxBottom, z_DetCldWatCondFactor, z_DetCldIceCondFactor, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, z_DQRainDt(l), z_DQSnowDt(l) )
! Detrainment mass tendency per unit mass (kg m-3 s-1 / ( kg m-3 ) = s-1).
! This corresponds to condensation rate (kg m-2 s-1) divided by layer thickness (m)
! and density (kg m-3), in other words.
! kg m-2 s-1 / ( Pa / ( m s-2 ) )
! = kg m-2 s-1 Pa-1 m s-1 = kg m-2 (kg m s-2 m-2)-1 m s-2
! = kg m-2 s-1 kg-1 m-1 s2 m2 m s-2 = s-1
if ( present( z_MoistConvDetTend ) ) then
z_MoistConvDetTend(l) = CldMassFluxBottom * NormMassFluxCldTop / ( z_DelPress(l) / Grav )
end if
if ( present( z_MoistConvSubsidMassFlux ) ) then
! Subsidence mass flux between the updrafts
do k = 1, l-1
if ( k > IndexMixLayTop ) then
DelNormMassFluxHalfLayer = - EntParam * z_BetaCldTop(k) * z_PotTemp(k)
NormMassFlux = r_NormMassFlux(k-1) - DelNormMassFluxHalfLayer
z_MoistConvSubsidMassFlux(k) = z_MoistConvSubsidMassFlux(k) + CldMassFluxBottom * NormMassFlux
end if
end do
end if
end if
end do loop_cloud_top
! Cumulus precipitation
call RASWithIceCalcPRCPStepPC1D( IndexMixLayTop, r_Press, z_Press, z_DQRainDt, z_DQSnowDt, z_Temp, z_QH2OVap, SurfRainFlux, SurfSnowFlux )
! 温度変化率, 比湿変化率
! Calculate specific humidity tendency and temperature tendency
! (In fact, temperature tendency does not need to calculate, here.)
!
z_DTempDtCumulus = ( z_Temp - z_TempB ) / ( 2.0_DP * DelTime )
z_DQVapDtCumulus = ( z_QH2OVap - z_QH2OVapB ) / ( 2.0_DP * DelTime )
z_DQH2OLiqDt = ( z_QH2OLiq - z_QH2OLiqB ) / ( 2.0_DP * DelTime )
z_DQH2OSolDt = ( z_QH2OSol - z_QH2OSolB ) / ( 2.0_DP * DelTime )
! Check conservation
call RASWithIce1DChkCons( r_Press, z_TempB, z_QH2OVapB, z_QH2OLiqB, z_QH2OSolB, z_UB, z_VB, z_Temp , z_QH2OVap , z_QH2OLiq , z_QH2OSol, SurfRainFlux, SurfSnowFlux, z_U , z_V )
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIceNoEntCond1D
| Subroutine : | |||||
| l : | integer , intent(in ) | ||||
| z_Press(1:kmax) : | real(DP), intent(in )
| ||||
| r_Press(0:kmax) : | real(DP), intent(in )
| ||||
| z_Exner(1:kmax) : | real(DP), intent(in )
| ||||
| r_Exner(0:kmax) : | real(DP), intent(in )
| ||||
| z_Temp(1:kmax) : | real(DP), intent(in )
| ||||
| z_QH2OVap(1:kmax) : | real(DP), intent(in )
| ||||
| z_QH2OLiq(1:kmax) : | real(DP), intent(in ) | ||||
| z_QH2OSol(1:kmax) : | real(DP), intent(in ) | ||||
| z_U(1:kmax) : | real(DP), intent(in ) | ||||
| z_V(1:kmax) : | real(DP), intent(in ) | ||||
| IndexMixLayTop : | integer , intent(in ) | ||||
| z_DelPress(1:kmax) : | real(DP), intent(in )
| ||||
| z_Beta(1:kmax) : | real(DP), intent(in ) | ||||
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) | ||||
| z_DetCldWatCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| z_DetCldIceCondFactor(1:kmax) : | real(DP), intent(in ) | ||||
| z_PotTemp(1:kmax) : | real(DP), intent(out )
| ||||
| z_DelNormMassFlux(1:kmax) : | real(DP), intent(out ) | ||||
| DelNormMassFluxCldTop : | real(DP), intent(out )
| ||||
| r_NormMassFlux(0:kmax) : | real(DP), intent(out ) | ||||
| NormMassFluxCldTop : | real(DP), intent(out ) | ||||
| CldQH2OLiqCldTop : | real(DP), intent(out )
| ||||
| CldQH2OSolCldTop : | real(DP), intent(out ) | ||||
| CWF : | real(DP), intent(out )
| ||||
| EntParam : | real(DP), intent(out )
| ||||
| z_Mu(1:kmax) : | real(DP), intent(out ) | ||||
| z_Eps(1:kmax) : | real(DP), intent(out ) | ||||
| z_Gamma(1:kmax) : | real(DP), intent(out ) | ||||
| z_GammaDSE(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OVap(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OLiq(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaQH2OSol(1:kmax) : | real(DP), intent(out )
| ||||
| GammaQRainDetLev : | real(DP), intent(out )
| ||||
| GammaQSnowDetLev : | real(DP), intent(out )
| ||||
| z_GammaU(1:kmax) : | real(DP), intent(out )
| ||||
| z_GammaV(1:kmax) : | real(DP), intent(out )
| ||||
| FlagEntParamOrderInapp : | logical , intent(out )
| ||||
| FlagNegH2OCondCldTop : | logical , intent(out )
| ||||
| rz_CldTemp(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OVap(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OLiq(0:kmax, 1:kmax) : | real(DP), intent(inout), optional | ||||
| rz_CldQH2OSol(0:kmax, 1:kmax) : | real(DP), intent(inout), optional |
relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
subroutine RASWithIceNoEntCond1DCore01( l, z_Press, r_Press, z_Exner, r_Exner, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_U, z_V, IndexMixLayTop, z_DelPress, z_Beta, z_BetaCldTop, z_DetCldWatCondFactor, z_DetCldIceCondFactor, z_PotTemp, z_DelNormMassFlux, DelNormMassFluxCldTop, r_NormMassFlux, NormMassFluxCldTop, CldQH2OLiqCldTop, CldQH2OSolCldTop, CWF, EntParam, z_Mu, z_Eps, z_Gamma, z_GammaDSE, z_GammaQH2OVap, z_GammaQH2OLiq, z_GammaQH2OSol, GammaQRainDetLev, GammaQSnowDetLev, z_GammaU, z_GammaV, FlagEntParamOrderInapp, FlagNegH2OCondCldTop, rz_CldTemp, rz_CldQH2OVap, rz_CldQH2OLiq, rz_CldQH2OSol )
!
! relaxed Arakawa-Schubert スキームにより, 温度と比湿を変化.
!
! Change temperature and specific humidity by relaxed Arakawa-Schubert scheme
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: Grav, GasRDry, CpDry, LatentHeat, LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only: a_CalcQVapSat, a_CalcDQVapSatDTemp
! Arakawa-Schubert scheme by Lord et al. (1982)
! Arakawa-Schubert scheme by Lord et al. (1982)
!
use arakawa_schubert_L1982, only : ASL1982CalcCWFCrtl1D
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only : SaturateWatFraction
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_Press (1:kmax)
! Pressure
real(DP), intent(in ) :: r_Press (0:kmax)
! Pressure
real(DP), intent(in ) :: z_Exner (1:kmax)
! Exner function
real(DP), intent(in ) :: r_Exner (0:kmax)
! Exner function
real(DP), intent(in ) :: z_Temp (1:kmax)
! Temperature
real(DP), intent(in ) :: z_QH2OVap (1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(in ) :: z_QH2OLiq(1:kmax)
real(DP), intent(in ) :: z_QH2OSol(1:kmax)
real(DP), intent(in ) :: z_U(1:kmax)
real(DP), intent(in ) :: z_V(1:kmax)
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(in ) :: z_DelPress(1:kmax)
! $ \Delta p $
!
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop (1:kmax)
real(DP), intent(in ) :: z_DetCldWatCondFactor (1:kmax)
real(DP), intent(in ) :: z_DetCldIceCondFactor (1:kmax)
!!$ real(DP), intent(inout) :: xy_Rain (0:imax-1, 1:jmax)
!!$ ! 降水量.
!!$ ! Precipitation
real(DP), intent(out ) :: z_PotTemp (1:kmax)
! Potential temperature
!
! Difference of normalized mass flux between layer interface
real(DP), intent(out ) :: z_DelNormMassFlux (1:kmax)
real(DP), intent(out ) :: DelNormMassFluxCldTop
! Normalized mass flux at layer interface and cloud top
real(DP), intent(out ) :: r_NormMassFlux (0:kmax)
real(DP), intent(out ) :: NormMassFluxCldTop
! cloud water in cloud at cloud top
real(DP), intent(out ) :: CldQH2OLiqCldTop
! cloud ice in cloud at cloud top
real(DP), intent(out ) :: CldQH2OSolCldTop
real(DP), intent(out ) :: CWF
! Cloud work function
real(DP), intent(out ) :: EntParam
! Entrainment factor
real(DP), intent(out ) :: z_Mu (1:kmax)
real(DP), intent(out ) :: z_Eps (1:kmax)
real(DP), intent(out ) :: z_Gamma (1:kmax)
real(DP), intent(out ) :: z_GammaDSE (1:kmax)
! Tendency of dry static energy per unit mass flux
!!$ real(DP), intent(out ) :: z_GammaMSE (1:kmax)
!!$ ! Tendency of moist static energy per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OVap (1:kmax)
! Tendency of water vapor per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OLiq (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(out ) :: z_GammaQH2OSol (1:kmax)
! Tendency of cloud water per unit mass flux
real(DP), intent(out ) :: GammaQRainDetLev
! Tendency of rain per unit mass flux
real(DP), intent(out ) :: GammaQSnowDetLev
! Tendency of snow per unit mass flux
real(DP), intent(out ) :: z_GammaU (1:kmax)
! Tendency of zonal wind per unit mass flux
real(DP), intent(out ) :: z_GammaV (1:kmax)
! Tendency of zonal wind per unit mass flux
!!$ real(DP), intent(out ) :: z_GammaQOthers (1:kmax)
!!$ ! Tendency of passive constituents per unit mass flux
logical , intent(out ) :: FlagEntParamOrderInapp
! Flags for modification of
logical , intent(out ) :: FlagNegH2OCondCldTop
! Flags for modification of
real(DP), intent(inout), optional :: rz_CldTemp (0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OVap(0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OLiq(0:kmax, 1:kmax)
real(DP), intent(inout), optional :: rz_CldQH2OSol(0:kmax, 1:kmax)
! 作業変数
! Work variables
!
real(DP) :: z_Height (1:kmax)
!
! Height
real(DP) :: r_Height (0:kmax)
!
! Height
real(DP) :: z_QH2OVapSat(1:kmax)
! 飽和比湿.
! Saturation specific humidity.
! Dry and moist static energy in environment (Env) and cloud (Cld)
!
real(DP) :: z_EnvDryStaticEne (1:kmax)
real(DP) :: r_EnvDryStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEne (1:kmax)
real(DP) :: r_EnvMoistStaticEne (0:kmax)
real(DP) :: z_EnvMoistStaticEneSat(1:kmax)
real(DP) :: r_EnvMoistStaticEneSat(0:kmax)
real(DP) :: z_EnvCondStaticEne (1:kmax)
real(DP) :: r_CldMoistStaticEne (0:kmax)
real(DP) :: r_CldCondStaticEne (0:kmax)
!!$ real(DP) :: CldCondStaticEneCldTop
real(DP) :: r_QH2OVap(0:kmax)
real(DP) :: r_QH2OLiq(0:kmax)
real(DP) :: r_QH2OSol(0:kmax)
real(DP) :: r_U(0:kmax)
real(DP) :: r_V(0:kmax)
real(DP) :: z_EntParam (1:kmax)
! Entrainment factor (variable for output)
!!$ real(DP) :: EntParamLL
!!$ ! Entrainment factor for a cloud with top at one layer
!!$ ! higher level
real(DP) :: CldMoistStaticEneCldTopUL
real(DP) :: CldQH2OVapCldTopUL
real(DP) :: EntParamUL
! Entrainment factor for a cloud with top at one layer
! lower level
! cloud total water in cloud
real(DP) :: r_CldQH2OTot(0:kmax)
! cloud total water in cloud at cloud top
real(DP) :: CldQH2OTotCldTop
! cloud condensate in cloud at cloud top
real(DP) :: CldQH2OCondCldTop
! water vapor in cloud at cloud top
real(DP) :: CldQH2OVapCldTop
real(DP) :: WatFrac
! Variables for debug
!
!!$ real(DP) :: xyz_DelVal(0:imax-1, 1:jmax, 1:kmax)
!!$ real(DP) :: xy_SumValB(0:imax-1, 1:jmax)
!!$ real(DP) :: xy_SumValA(0:imax-1, 1:jmax)
!!$ real(DP) :: Ratio
real(DP) :: CldTempB
real(DP) :: a_DQVapSatDTemp(1:1)
real(DP) :: DelTemp
real(DP) :: r_CldTemp (0:kmax)
real(DP) :: r_CldQH2OVap(0:kmax)
real(DP) :: r_CldQH2OLiq(0:kmax)
real(DP) :: r_CldQH2OSol(0:kmax)
real(DP) :: r_CldHeight (0:kmax)
real(DP) :: r_CldDryStaticEne(0:kmax)
!!$ real(DP) :: DEntParamDQH2OSol
!!$ real(DP) :: DelCldQH2OSolCldTop
real(DP) :: CldMoistStaticEneCldTop
real(DP) :: NormH2OTotFlux
real(DP) :: r_CldU (0:kmax)
real(DP) :: r_CldV (0:kmax)
real(DP) :: z_Val (1:kmax)
real(DP) :: r_Val (0:kmax)
real(DP) :: r_CldVal (0:kmax)
real(DP) :: z_GammaVal (1:kmax)
real(DP) :: NormValFlux
real(DP) :: CldUCldTop
real(DP) :: CldVCldTop
real(DP) :: CldValCldTop
real(DP) :: z_MuPrime (1:kmax)
real(DP) :: z_EpsPrime(1:kmax)
!!$ real(DP) :: TmpSum
integer :: loopmax = 100
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer :: m
! 実行文 ; Executable statement
!
! 初期化確認
! Initialization check
!
if ( .not. relaxed_arakawa_schubert_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
! 計算時間計測開始
! Start measurement of computation time
!
!!$ call TimesetClockStart( module_name )
call RAS1DHeight( z_Temp, z_Exner, z_Beta, z_BetaCldTop, z_Height, r_Height )
! Potential temperature
!
z_PotTemp = z_Temp / z_Exner
! Saturation mixing ratio
!
z_QH2OVapSat = a_CalcQVapSat( z_Temp, z_Press )
! Calculation of dry and moist static energies
!
z_EnvDryStaticEne = CpDry * z_Temp + Grav * z_Height
z_EnvMoistStaticEne = z_EnvDryStaticEne + LatentHeat * z_QH2OVap
!
k = 0
r_EnvDryStaticEne (k) = 1.0d100
r_EnvMoistStaticEne(k) = 1.0d100
do k = 1, kmax-1
r_EnvDryStaticEne (k) = ( z_EnvDryStaticEne (k) + z_EnvDryStaticEne (k+1) ) / 2.0_DP
r_EnvMoistStaticEne(k) = ( z_EnvMoistStaticEne(k) + z_EnvMoistStaticEne(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvDryStaticEne (k) = z_EnvDryStaticEne (k)
r_EnvMoistStaticEne(k) = z_EnvMoistStaticEne(k)
! Calculation of saturated moist static energy
!
z_EnvMoistStaticEneSat = z_EnvDryStaticEne + LatentHeat * z_QH2OVapSat
!
k = 0
r_EnvMoistStaticEneSat(k) = 1.0d100
do k = 1, kmax-1
r_EnvMoistStaticEneSat(k) = ( z_EnvMoistStaticEneSat(k) + z_EnvMoistStaticEneSat(k+1) ) / 2.0_DP
end do
k = kmax
r_EnvMoistStaticEneSat(k) = z_EnvMoistStaticEneSat(k)
! Calculation of saturated moist static energy
!
z_EnvCondStaticEne = z_EnvMoistStaticEne - LatentHeatFusion * z_QH2OSol
k = 0
r_QH2OVap(k) = 1.0d100
r_QH2OLiq(k) = 1.0d100
r_QH2OSol(k) = 1.0d100
do k = 1, kmax-1
r_QH2OVap(k) = ( z_QH2OVap(k) + z_QH2OVap(k+1) ) / 2.0_DP
r_QH2OLiq(k) = ( z_QH2OLiq(k) + z_QH2OLiq(k+1) ) / 2.0_DP
r_QH2OSol(k) = ( z_QH2OSol(k) + z_QH2OSol(k+1) ) / 2.0_DP
end do
k = kmax
r_QH2OVap(k) = z_QH2OVap(k)
r_QH2OLiq(k) = z_QH2OLiq(k)
r_QH2OSol(k) = z_QH2OSol(k)
k = 0
r_U(k) = 1.0d100
r_V(k) = 1.0d100
do k = 1, kmax-1
r_U(k) = ( z_U(k) + z_U(k+1) ) / 2.0_DP
r_V(k) = ( z_V(k) + z_V(k+1) ) / 2.0_DP
end do
k = kmax
r_U(k) = z_U(k)
r_V(k) = z_V(k)
! Entrainment parameter
!
!!$ ! cloud condensate static energy at cloud top
!!$ CldCondStaticEneCldTop = &
!!$ & z_EnvMoistStaticEneSat(l) - LatentHeatFusion * CldQH2OSolCldTop
! Entrainment parameter
!
CldMoistStaticEneCldTop = z_EnvMoistStaticEneSat(l)
CldQH2OVapCldTop = z_QH2OVapSat(l)
call RASWithIceNoEntCond1DEntParam( l, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvMoistStaticEne, CldQH2OVapCldTop, CldMoistStaticEneCldTop, IndexMixLayTop, EntParam )
! subroutines below are commented out temporarily
!!$ if ( l >= 3 ) then
!!$ call RASEntParam1D( &
!!$ & l-1, & ! (in)
!!$ & z_Beta, z_BetaCldTop, z_PotTemp, & ! (in)
!!$ & z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, & ! (in)
!!$ & IndexMixLayTop, & ! (in)
!!$ & EntParamLL & ! (out)
!!$ & )
!!$ else
!!$ EntParamLL = 1.0d100
!!$ end if
if ( l <= kmax-1 ) then
!!$ call RASEntParam1D( &
!!$ & l+1, & ! (in)
!!$ & z_Beta, z_BetaCldTop, z_PotTemp, & ! (in)
!!$ & z_EnvMoistStaticEne, z_EnvMoistStaticEneSat, & ! (in)
!!$ & IndexMixLayTop, & ! (in)
!!$ & EntParamUL & ! (out)
!!$ & )
CldMoistStaticEneCldTopUL = z_EnvMoistStaticEneSat(l+1)
CldQH2OVapCldTopUL = z_QH2OVapSat(l+1)
call RASWithIceNoEntCond1DEntParam( l+1, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvMoistStaticEne, CldQH2OVapCldTopUL, CldMoistStaticEneCldTopUL, IndexMixLayTop, EntParamUL )
else
EntParamUL = 1.0d100
end if
! for output
z_EntParam(l) = EntParam
! Check variation of entrainment parameter with altitude
FlagEntParamOrderInapp = .false.
if ( ( EntParam > 0.0_DP ) .and. ( EntParamUL > 0.0_DP ) ) then
if ( EntParam < EntParamUL ) then
FlagEntParamOrderInapp = .true.
end if
end if
! Difference of normalized mass flux
!
! difference of normalized mass flux between layer bottom and top
!
z_DelNormMassFlux(1) = 1.0d100
do k = 2, l-1
z_DelNormMassFlux(k) = - EntParam * z_Beta(k) * z_PotTemp(k)
end do
do k = l, kmax
z_DelNormMassFlux(k) = 1.0d100
end do
!
! difference of normalized mass flux between layer bottom and mid-point
!
DelNormMassFluxCldTop = - EntParam * z_BetaCldTop(l) * z_PotTemp(l)
! Normalized mass flux
!
! normalized mass flux at layer interface
!
r_NormMassFlux(0) = 0.0_DP
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_NormMassFlux(k) = 0.0_DP
else if ( k == IndexMixLayTop ) then
r_NormMassFlux(k) = 1.0_DP
else
r_NormMassFlux(k) = r_NormMassFlux(k-1) - z_DelNormMassFlux(k)
end if
end do
do k = l, kmax
r_NormMassFlux(k) = 0.0_DP
end do
!
! normalized mass flux at cloud top (at layer mid-point)
!
NormMassFluxCldTop = r_NormMassFlux(l-1) - DelNormMassFluxCldTop
! Liquid water content at top of clouds
! If l is less than xy_IndexMixLayTop(i,j), i.e. the cloud top is below
! top of mixed layer, xy_SumTmp is zero, then, xy_CldQH2OLiqCldTop is
! also zero.
!
if ( l > IndexMixLayTop ) then
do k = 0, IndexMixLayTop-1
r_CldQH2OTot(k) = 1.0d100
end do
k = IndexMixLayTop
!!$ NormH2OTotFlux = z_QH2OVap(k) * r_NormMassFlux(k)
!!$ NormH2OTotFlux = ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) ) &
!!$ & * r_NormMassFlux(k)
! No entrainment of condensate
NormH2OTotFlux = z_QH2OVap(k) * r_NormMassFlux(k)
r_CldQH2OTot(k) = NormH2OTotFlux / r_NormMassFlux(k)
do k = IndexMixLayTop+1, l-1
!!$ r_CldQH2OTot(k) = r_CldQH2OTot(k-1) * r_NormMassFlux(k-1) ######&
!!$ & - z_DelNormMassFlux(k) &
!!$ & * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
!!$ NormH2OTotFlux = NormH2OTotFlux &
!!$ & - z_DelNormMassFlux(k) &
!!$ & * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
! No entrainment of condensate
NormH2OTotFlux = NormH2OTotFlux - z_DelNormMassFlux(k) * z_QH2OVap(k)
r_CldQH2OTot(k) = NormH2OTotFlux / r_NormMassFlux(k)
end do
!!$ NormH2OTotFlux = NormH2OTotFlux &
!!$ & - DelNormMassFluxCldTop &
!!$ & * ( z_QH2OVap(l) + z_QH2OLiq(l) + z_QH2OSol(l) )
! No entrainment of condensate
NormH2OTotFlux = NormH2OTotFlux - DelNormMassFluxCldTop * z_QH2OVap(l)
CldQH2OTotCldTop = NormH2OTotFlux / NormMassFluxCldTop
do k = l, kmax
r_CldQH2OTot(k) = 1.0d100
end do
else
r_CldQH2OTot = 0.0_DP
CldQH2OTotCldTop = 0.0_DP
end if
!!$ CldQH2OCondCldTop = CldQH2OTotCldTop - z_QH2OVapSat(l)
CldQH2OCondCldTop = CldQH2OTotCldTop - CldQH2OVapCldTop
! This is old version
! In this version, CldQH2OLiqCldTop and CldQH2OSolCldTop are calculated
! in RASEntParamWithIce1D subroutine.
! These values can be calculated from CldQH2OTotCldTop, which should be
! same as a value calculated in current manner.
!!$ CldQH2OCondCldTop = CldQH2OLiqCldTop + CldQH2OSolCldTop
! Check whether kernel is positive or negative.
!
!!$ if ( CldQH2OCondCldTop < 0.0_DP ) then
if ( CldQH2OCondCldTop < 0.0_DP ) then
FlagNegH2OCondCldTop = .true.
else
FlagNegH2OCondCldTop = .false.
end if
! avoid negative value
CldQH2OCondCldTop = max( CldQH2OCondCldTop, 0.0_DP )
call SaturateWatFraction( z_Temp(l), WatFrac )
CldQH2OLiqCldTop = WatFrac * CldQH2OCondCldTop
CldQH2OSolCldTop = ( 1.0_DP - WatFrac ) * CldQH2OCondCldTop
! Condensate static energy and moist static energy in clouds
!
r_CldCondStaticEne(0) = 1.0d100
do k = 1, l-1
if ( k < IndexMixLayTop ) then
r_CldCondStaticEne(k) = 1.0d100
else if ( k == IndexMixLayTop ) then
!!$ r_CldCondStaticEne(k) = &
!!$ & z_EnvCondStaticEne(IndexMixLayTop)
! No entrainment of condensate
r_CldCondStaticEne(k) = z_EnvMoistStaticEne(IndexMixLayTop)
else
!!$ r_CldCondStaticEne(k) = &
!!$ & ( r_NormMassFlux(k-1) * r_CldCondStaticEne(k-1) &
!!$ & - z_DelNormMassFlux(k) * z_EnvCondStaticEne(k) ) &
!!$ & / r_NormMassFlux(k)
! No entrainment of condensate
r_CldCondStaticEne(k) = ( r_NormMassFlux(k-1) * r_CldCondStaticEne(k-1) - z_DelNormMassFlux(k) * z_EnvMoistStaticEne(k) ) / r_NormMassFlux(k)
end if
end do
do k = l, kmax
r_CldCondStaticEne(k) = 1.0d100
end do
if ( EntParam >= 0.0_DP ) then
! Calculation of cloud air temperature
! This value will not be used below.
! This is an attempt for next extention.
!
do k = 0, IndexMixLayTop-1
r_CldTemp (k) = 1.0d100
r_CldQH2OVap (k) = 1.0d100
r_CldQH2OLiq (k) = 1.0d100
r_CldQH2OSol (k) = 1.0d100
r_CldHeight (k) = 1.0d100
r_CldMoistStaticEne(k) = 1.0d100
end do
k = IndexMixLayTop
r_CldTemp (k) = z_Temp(k)
r_CldQH2OVap(k) = z_QH2OVap(k)
!!$ r_CldQH2OLiq(k) = z_QH2OLiq(k)
!!$ r_CldQH2OSol(k) = z_QH2OSol(k)
! No entrainment of condensate
r_CldQH2OLiq(k) = 0.0_DP
r_CldQH2OSol(k) = 0.0_DP
r_CldHeight (k) = r_Height(k)
r_CldMoistStaticEne(k) = r_CldCondStaticEne(k) + LatentHeatFusion * r_CldQH2OSol(k)
do k = IndexMixLayTop+1, l-1
! Iteration
! Initialization
if ( k == IndexMixLayTop+1 ) then
r_CldTemp(k) = z_Temp(k)
else
r_CldTemp(k) = r_CldTemp(k-1)
end if
!
! It is assumed that WatFrac does not change during iteration, since
! variable WatFrac causes non-convergence of iteration sometime.
call SaturateWatFraction( r_CldTemp(k), WatFrac )
!
loop_cloud_properties : do m = 1, loopmax
CldTempB = r_CldTemp(k)
r_CldQH2OVap(k:k) = a_CalcQVapSat( r_CldTemp(k:k), r_Press(k:k) )
a_DQVapSatDTemp(1:1) = a_CalcDQVapSatDTemp( r_CldTemp(k:k), r_CldQH2OVap(k:k) )
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
DelTemp = ( r_CldCondStaticEne(k) - CpDry * r_CldTemp(k) - Grav * r_CldHeight(k) - ( LatentHeat + LatentHeatFusion * ( 1.0_DP - WatFrac ) ) * r_CldQH2OVap(k) + LatentHeatFusion * ( 1.0_DP - WatFrac ) * r_CldQH2OTot(k) ) / ( CpDry + ( LatentHeat + LatentHeatFusion * ( 1.0_DP - WatFrac ) ) * a_DQVapSatDTemp(1) + z_Beta(k) / r_Exner(k) / 2.0_DP )
r_CldTemp (k) = r_CldTemp (k) + DelTemp
r_CldQH2OVap(k) = r_CldQH2OVap(k) + a_DQVapSatDTemp(1) * DelTemp
! update height by the use of updated temperature
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
!!$ write( 6, * ) EntParam, l, k, m, r_CldMoistStaticEne(k), Grav * r_CldHeight(k), r_CldTemp(k), r_CldQH2OVap(k)
!!$ if ( abs( CldTempB - r_CldTemp(k) ) / CldTempB < 1.0d-3 ) &
if ( abs( DelTemp ) < 1.0d-3 ) exit loop_cloud_properties
end do loop_cloud_properties
if ( m >= loopmax ) then
call MessageNotify( 'E', module_name, 'Number of loop for cloud properties is too large, %d.', i = (/m/) )
end if
if ( ( r_CldQH2OTot(k) - r_CldQH2OVap(k) ) >= 0.0_DP ) then
! cloud water and cloud ice
call SaturateWatFraction( r_CldTemp(k), WatFrac )
!
r_CldQH2OLiq(k) = ( r_CldQH2OTot(k) - r_CldQH2OVap(k) ) * WatFrac
r_CldQH2OSol(k) = r_CldQH2OTot(k) - r_CldQH2OVap(k) - r_CldQH2OLiq(k)
else
r_CldQH2OVap(k) = r_CldQH2OTot(k )
r_CldQH2OLiq(k) = 0.0_DP
r_CldQH2OSol(k) = 0.0_DP
!
r_CldTemp (k) = ( r_CldCondStaticEne(k) - Grav * r_CldHeight(k-1) - Grav * z_Beta(k) * r_CldTemp(k-1) / r_Exner(k-1) / 2.0_DP - LatentHeat * r_CldQH2OVap(k) + LatentHeatFusion * r_CldQH2OSol(k) ) / ( CpDry + Grav * z_Beta(k) / r_Exner(k) / 2.0_DP )
! r_CldHeight is estimated again with a new temperature
r_CldHeight(k) = r_CldHeight(k-1) + z_Beta(k) * ( r_CldTemp(k-1) / r_Exner(k-1) + r_CldTemp(k) / r_Exner(k) ) / 2.0_DP
end if
r_CldMoistStaticEne(k) = r_CldCondStaticEne(k) + LatentHeatFusion * r_CldQH2OSol(k)
end do
do k = l, kmax
r_CldTemp (k) = 1.0d100
r_CldQH2OVap (k) = 1.0d100
r_CldQH2OLiq (k) = 1.0d100
r_CldQH2OSol (k) = 1.0d100
r_CldMoistStaticEne(k) = 1.0d100
end do
do k = 0, IndexMixLayTop-1
r_CldDryStaticEne(k) = 1.0d100
end do
do k = IndexMixLayTop, l-1
r_CldDryStaticEne(k) = CpDry * r_CldTemp(k) + Grav * r_CldHeight(k)
end do
do k = l, kmax
r_CldDryStaticEne(k) = 1.0d100
end do
else
r_CldTemp = 1.0d100
r_CldQH2OVap = 1.0d100
r_CldQH2OLiq = 1.0d100
r_CldQH2OSol = 1.0d100
r_CldMoistStaticEne = 1.0d100
r_CldDryStaticEne = 1.0d100
end if
if ( present( rz_CldTemp ) ) rz_CldTemp (:,l) = r_CldTemp
if ( present( rz_CldQH2OVap ) ) rz_CldQH2OVap(:,l) = r_CldQH2OVap
if ( present( rz_CldQH2OLiq ) ) rz_CldQH2OLiq(:,l) = r_CldQH2OLiq
if ( present( rz_CldQH2OSol ) ) rz_CldQH2OSol(:,l) = r_CldQH2OSol
!###############################################
! Check whether a parcel in cloud has moist static energy larger than environment's
!
!!$ xy_FlagCrossSatEquivPotTemp = .false.
!!$ do j = 1, jmax
!!$ do i = 0, imax-1
!!$ do k = xy_IndexMixLayTop(i,j), l-1
!!$ if ( xyr_EnvMoistStaticEneSat(i,j,k) < xyr_CldMoistStaticEne(i,j,k) ) then
!!$ xy_FlagCrossSatEquivPotTemp(i,j) = .true.
!!$ end if
!!$ end do
!!$ end do
!!$ end do
!###############################################
! Cloud work function
!
! Auxiliary variables
!
z_Gamma = LatentHeat / CpDry * a_CalcDQVapSatDTemp( z_Temp, z_QH2OVapSat )
!
k = 1
z_Mu (k) = 1.0d100
z_Eps(k) = 1.0d100
do k = 2, kmax
z_Mu (k) = ( z_Exner(k ) - r_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
z_Eps(k) = ( r_Exner(k-1) - z_Exner(k) ) / ( z_Exner(k) * ( 1.0_DP + z_Gamma(k) ) )
end do
!
! Cloud work function
!
!!$ ! approximation form
!!$ !
!!$ CWF = 0.0_DP
!!$ do k = 2, l-1
!!$ if ( k > IndexMixLayTop ) then
!!$ CWF = CWF &
!!$ & + z_Mu (k) * r_NormMassFlux(k ) &
!!$ & * ( r_CldMoistStaticEne(k ) - z_EnvMoistStaticEneSat(k) ) &
!!$ & + z_Eps(k) * r_NormMassFlux(k-1) &
!!$ & * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
!!$ end if
!!$ end do
!!$ k = l
!!$ if ( k > IndexMixLayTop ) then
!!$ CWF = CWF &
!!$ & + z_Eps(k) * r_NormMassFlux(k-1) &
!!$ & * ( r_CldMoistStaticEne(k-1) - z_EnvMoistStaticEneSat(k) )
!!$ end if
!
! original form
!
k = 1
z_MuPrime (k) = 1.0d100
z_EpsPrime(k) = 1.0d100
do k = 2, kmax
z_MuPrime (k) = ( z_Exner(k ) - r_Exner(k) ) / z_Exner(k)
z_EpsPrime(k) = ( r_Exner(k-1) - z_Exner(k) ) / z_Exner(k)
end do
CWF = 0.0_DP
do k = 2, l-1
if ( k > IndexMixLayTop ) then
CWF = CWF + z_MuPrime (k) * r_NormMassFlux(k ) * ( r_CldDryStaticEne(k ) - z_EnvDryStaticEne(k) ) + z_EpsPrime(k) * r_NormMassFlux(k-1) * ( r_CldDryStaticEne(k-1) - z_EnvDryStaticEne(k) )
end if
end do
k = l
if ( k > IndexMixLayTop ) then
CWF = CWF + z_EpsPrime(k) * r_NormMassFlux(k-1) * ( r_CldDryStaticEne(k-1) - z_EnvDryStaticEne(k) )
end if
! Tendency of dry static energy per unit mass flux
!
do k = 1, l
z_GammaDSE(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_EnvDryStaticEne(k-1) - z_EnvDryStaticEne(k) ) + r_NormMassFlux(k ) * ( z_EnvDryStaticEne(k ) - r_EnvDryStaticEne(k) ) )
end do
k = l
z_GammaDSE(k) = z_GammaDSE(k) - Grav / z_DelPress(k) * LatentHeat * CldQH2OLiqCldTop * NormMassFluxCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) ) - Grav / z_DelPress(k) * LatentHeatFusion * CldQH2OLiqCldTop * NormMassFluxCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaDSE(k) = 0.0_DP
end do
! Tendency of moist static energy per unit mass flux
!
!!$ do k = 1, l
!!$ z_GammaMSE(k) = &
!!$ & - Grav / z_DelPress(k) &
!!$ & * ( r_NormMassFlux(k-1) &
!!$ & * ( r_EnvMoistStaticEne(k-1) - z_EnvMoistStaticEne(k) ) &
!!$ & + r_NormMassFlux(k ) &
!!$ & * ( z_EnvMoistStaticEne(k ) - r_EnvMoistStaticEne(k) ) &
!!$ & )
!!$ end do
!!$ k = l
!!$ z_GammaMSE(k) = z_GammaMSE(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( z_EnvMoistStaticEneSat(k) - z_EnvMoistStaticEne(k) )
!!$ do k = l+1, kmax
!!$ z_GammaMSE(k) = 0.0_DP
!!$ end do
! Tendency of water vapor per unit mass flux
!
do k = 1, l
z_GammaQH2OVap(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_QH2OVap(k-1) - z_QH2OVap(k) ) + r_NormMassFlux(k ) * ( z_QH2OVap(k ) - r_QH2OVap(k) ) )
end do
k = l
z_GammaQH2OVap(k) = z_GammaQH2OVap(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OVapCldTop - z_QH2OVap(k) ) + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) )
! No entrainment of condensate
do k = l+1, kmax
z_GammaQH2OVap(k) = 0.0_DP
end do
! Tendency of cloud water per unit mass flux
!
do k = 1, l
!!$ z_GammaQH2OLiq(k) = &
!!$ & - Grav / z_DelPress(k) &
!!$ & * ( r_NormMassFlux(k-1) &
!!$ & * ( r_QH2OLiq(k-1) - z_QH2OLiq(k) ) &
!!$ & + r_NormMassFlux(k ) &
!!$ & * ( z_QH2OLiq(k ) - r_QH2Oliq(k) ) &
!!$ & )
! No entrainment of condensate
z_GammaQH2OLiq(k) = 0.0_DP
end do
k = l
!!$ z_GammaQH2OLiq(k) = z_GammaQH2OLiq(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( CldQH2OLiqCldTop - z_QH2OLiq(k) ) &
!!$ & - Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OLiqCldTop * ( 1.0_DP - z_RainFactor(k) ) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OSolCldTop * ( 1.0_DP - z_SnowFactor(k) )
! No entrainment of condensate
z_GammaQH2OLiq(k) = z_GammaQH2OLiq(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OLiqCldTop - 0.0_DP ) - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OLiqCldTop * ( 1.0_DP - z_DetCldWatCondFactor(k) ) + Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaQH2OLiq(k) = 0.0_DP
end do
GammaQRainDetLev = 0.0_DP
! Tendency of cloud ice per unit mass flux
!
do k = 1, l
!!$ z_GammaQH2OSol(k) = &
!!$ & - Grav / z_DelPress(k) &
!!$ & * ( r_NormMassFlux(k-1) &
!!$ & * ( r_QH2OSol(k-1) - z_QH2OSol(k) ) &
!!$ & + r_NormMassFlux(k ) &
!!$ & * ( z_QH2OSol(k ) - r_QH2OSol(k) ) &
!!$ & )
! No entrainment of condensate
z_GammaQH2OSol(k) = 0.0_DP
end do
k = l
!!$ z_GammaQH2OSol(k) = z_GammaQH2OSol(k) &
!!$ & + Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * ( CldQH2OSolCldTop - z_QH2OSol(k) ) &
!!$ & - Grav / z_DelPress(k) &
!!$ & * NormMassFluxCldTop &
!!$ & * CldQH2OSolCldTop * ( 1.0_DP - z_SnowFactor(k) )
! No entrainment of condensate
z_GammaQH2OSol(k) = z_GammaQH2OSol(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldQH2OSolCldTop - 0.0_DP ) - Grav / z_DelPress(k) * NormMassFluxCldTop * CldQH2OSolCldTop * ( 1.0_DP - z_DetCldIceCondFactor(k) )
do k = l+1, kmax
z_GammaQH2OSol(k) = 0.0_DP
end do
GammaQSnowDetLev = 0.0_DP
! Tendency of zonal and meridional windsper unit mass flux
!
if ( FlagMomMix ) then
do m = 1, 2
select case ( m )
case ( 1 )
z_Val = z_U
r_Val = r_U
case ( 2 )
z_Val = z_V
r_Val = r_V
case default
call MessageNotify( 'E', module_name, 'Unexpected case.' )
end select
!
if ( l > IndexMixLayTop ) then
do k = 0, IndexMixLayTop-1
r_CldVal(k) = 1.0d100
end do
k = IndexMixLayTop
NormValFlux = z_Val(k) * r_NormMassFlux(k)
r_CldVal(k) = NormValFlux / r_NormMassFlux(k)
do k = IndexMixLayTop+1, l-1
NormValFlux = NormValFlux - z_DelNormMassFlux(k) * z_Val(k)
r_CldVal(k) = NormValFlux / r_NormMassFlux(k)
end do
NormValFlux = NormValFlux - DelNormMassFluxCldTop * z_Val(l)
CldValCldTop = NormValFlux / NormMassFluxCldTop
do k = l, kmax
r_CldVal(k) = 1.0d100
end do
else
r_CldVal = 0.0_DP
CldValCldTop = 0.0_DP
end if
do k = 1, l
z_GammaVal(k) = - Grav / z_DelPress(k) * ( r_NormMassFlux(k-1) * ( r_Val(k-1) - z_Val(k) ) + r_NormMassFlux(k ) * ( z_Val(k ) - r_Val(k) ) )
end do
k = l
z_GammaVal(k) = z_GammaVal(k) + Grav / z_DelPress(k) * NormMassFluxCldTop * ( CldValCldTop - z_Val(k) )
do k = l+1, kmax
z_GammaVal(k) = 0.0_DP
end do
!
select case ( m )
case ( 1 )
r_CldU = r_CldVal
CldUCldTop = CldValCldTop
z_GammaU = z_GammaVal
case ( 2 )
r_CldV = r_CldVal
CldVCldTop = CldValCldTop
z_GammaV = z_GammaVal
end select
end do
else
r_CldU = 1.0d100
CldUCldTop = 1.0d100
z_GammaU = 0.0_DP
r_CldV = 1.0d100
CldVCldTop = 1.0d100
z_GammaV = 0.0_DP
end if
! 計算時間計測一時停止
! Pause measurement of computation time
!
!!$ call TimesetClockStop( module_name )
end subroutine RASWithIceNoEntCond1DCore01
| Subroutine : | |||||||
| l : | integer , intent(in ) | ||||||
| z_Temp(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OVap(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OLiq(1:kmax) : | real(DP), intent(in ) | ||||||
| z_QH2OSol(1:kmax) : | real(DP), intent(in ) | ||||||
| z_PotTemp(1:kmax) : | real(DP), intent(in ) | ||||||
| z_Beta(1:kmax) : | real(DP), intent(in ) | ||||||
| z_BetaCldTop(1:kmax) : | real(DP), intent(in ) | ||||||
| z_EnvMoistStaticEne(1:kmax) : | real(DP), intent(in ) | ||||||
| CldQH2OVapCldTop : | real(DP), intent(in ) | ||||||
| CldMoistStaticEneCldTop : | real(DP), intent(in ) | ||||||
| IndexMixLayTop : | integer , intent(in ) | ||||||
| EntParam : | real(DP), intent(out)
|
エントレインメントパラメータの計算
Calculation of entrainment parameter
subroutine RASWithIceNoEntCond1DEntParam( l, z_Temp, z_QH2OVap, z_QH2OLiq, z_QH2OSol, z_PotTemp, z_Beta, z_BetaCldTop, z_EnvMoistStaticEne, CldQH2OVapCldTop, CldMoistStaticEneCldTop, IndexMixLayTop, EntParam )
!
! エントレインメントパラメータの計算
!
! Calculation of entrainment parameter
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: LatentHeatFusion
! $ L $ [J kg-1] .
! 融解の潜熱.
! Latent heat of fusion
! 飽和比湿の算出
! Evaluate saturation specific humidity
!
use saturate, only : SaturateWatFraction
! 宣言文 ; Declaration statements
!
integer , intent(in ) :: l
real(DP), intent(in ) :: z_Temp (1:kmax)
real(DP), intent(in ) :: z_QH2OVap (1:kmax)
real(DP), intent(in ) :: z_QH2OLiq (1:kmax)
real(DP), intent(in ) :: z_QH2OSol (1:kmax)
real(DP), intent(in ) :: z_PotTemp (1:kmax)
real(DP), intent(in ) :: z_Beta (1:kmax)
real(DP), intent(in ) :: z_BetaCldTop (1:kmax)
real(DP), intent(in ) :: z_EnvMoistStaticEne (1:kmax)
real(DP), intent(in ) :: CldQH2OVapCldTop
real(DP), intent(in ) :: CldMoistStaticEneCldTop
integer , intent(in ) :: IndexMixLayTop
real(DP), intent(out) :: EntParam
!!$ real(DP), intent(out) :: CldQH2OLiqCldTop
!!$ real(DP), intent(out) :: CldQH2OSolCldTop
! 作業変数
! Work variables
!
real(DP) :: WatFrac
real(DP) :: TmpA
real(DP) :: TmpB
real(DP) :: TmpC
!!$ real(DP) :: QETermA
!!$ real(DP) :: QETermB
!!$ real(DP) :: QETermC
!!$ real(DP) :: TmpSum
!!$ real(DP) :: CldQH2OCondCldTop
integer :: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
! 実行文 ; Executable statement
!
! Entrainment parameter
!
if ( l > IndexMixLayTop ) then
call SaturateWatFraction( z_Temp(l), WatFrac )
TmpA = 0.0_DP
do k = IndexMixLayTop+1, l-1
TmpA = TmpA + z_Beta(k) * z_PotTemp(k)
end do
TmpA = TmpA + z_BetaCldTop(l) * z_PotTemp(l)
TmpB = 0.0_DP
do k = IndexMixLayTop+1, l-1
!!$ TmpB = TmpB &
!!$ & + z_Beta(k) * z_PotTemp(k) &
!!$ & * ( z_QH2OVap(k) + z_QH2OLiq(k) + z_QH2OSol(k) )
! No entrainment of condensate
TmpB = TmpB + z_Beta(k) * z_PotTemp(k) * z_QH2OVap(k)
end do
!!$ TmpB = TmpB &
!!$ & + z_BetaCldTop(l) * z_PotTemp(l) &
!!$ & * ( z_QH2OVap(l) + z_QH2OLiq(l) + z_QH2OSol(l) )
! No entrainment of condensate
TmpB = TmpB + z_BetaCldTop(l) * z_PotTemp(l) * z_QH2OVap(l)
TmpC = 0.0_DP
do k = IndexMixLayTop+1, l-1
!!$ TmpC = TmpC &
!!$ & + z_Beta(k) * z_PotTemp(k) &
!!$ & * ( CldMoistStaticEneCldTop - z_EnvCondStaticEne(k) )
! No entrainment of condensate
TmpC = TmpC + z_Beta(k) * z_PotTemp(k) * ( CldMoistStaticEneCldTop - z_EnvMoistStaticEne(k) )
end do
!!$ TmpC = TmpC &
!!$ & + z_BetaCldTop(l) * z_PotTemp(l) &
!!$ & * ( CldMoistStaticEneCldTop - z_EnvCondStaticEne(l) )
! No entrainment of condensate
TmpC = TmpC + z_BetaCldTop(l) * z_PotTemp(l) * ( CldMoistStaticEneCldTop - z_EnvMoistStaticEne(l) )
!!$ EntParam = &
!!$ & ( ( z_EnvCondStaticEne(IndexMixLayTop) - CldMoistStaticEneCldTop ) &
!!$ & + LatentHeatFusion * ( 1.0_DP - WatFrac ) &
!!$ & * ( z_QH2OVap(IndexMixLayTop) &
!!$ & + z_QH2OLiq(IndexMixLayTop) &
!!$ & + z_QH2OSol(IndexMixLayTop) &
!!$ & - CldQH2OVapCldTop ) ) &
!!$ & / ( TmpC &
!!$ & - LatentHeatFusion * ( 1.0_DP - WatFrac ) * ( TmpB - TmpA * CldQH2OVapCldTop ) )
! No entrainment of condensate
EntParam = ( ( z_EnvMoistStaticEne(IndexMixLayTop) - CldMoistStaticEneCldTop ) + LatentHeatFusion * ( 1.0_DP - WatFrac ) * ( z_QH2OVap(IndexMixLayTop) - CldQH2OVapCldTop ) ) / ( TmpC - LatentHeatFusion * ( 1.0_DP - WatFrac ) * ( TmpB - TmpA * CldQH2OVapCldTop ) )
!!$ CldQH2OCondCldTop = &
!!$ & ( z_QH2OVap(IndexMixLayTop) + EntParam * TmpB ) &
!!$ & / ( 1.0_DP + EntParam * TmpA ) &
!!$ & - CldQH2OVapCldTop
!!$ CldQH2OLiqCldTop = WatFrac * CldQH2OCondCldTop
!!$ CldQH2OSolCldTop = ( 1.0_DP - WatFrac ) * CldQH2OCondCldTop
else
EntParam = 0.0_DP
!!$ CldQH2OLiqCldTop = 0.0_DP
!!$ CldQH2OSolCldTop = 0.0_DP
end if
end subroutine RASWithIceNoEntCond1DEntParam
| Variable : | |||
| RainSnowConvFactor0 : | real(DP), save
|
| Variable : | |||
| RainSnowConvFactor1 : | real(DP), save
|
| Constant : | |||
| module_name = ‘relaxed_arakawa_schubert‘ : | character(*), parameter
|
| Variable : | |||
| relaxed_arakawa_schubert_inited = .false. : | logical, save
|
| Constant : | |||
| version = ’$Name: $’ // ’$Id: relaxed_arakawa_schubert.f90,v 1.15 2015/03/11 04:50:19 yot Exp $’ : | character(*), parameter
|