Subroutine : |
|
xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
: | $ T $ . 温度. Temperature
|
|
xyz_QVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
: | $ q $ . 比湿. Specific humidity
|
|
xy_Rain(0:imax-1, 1:jmax) : | real(DP), intent(inout)
|
xyz_DTempDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
: | 温度変化率. Temperature tendency
|
|
xyz_DQVapDt(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout)
: | 比湿変化率. Specific humidity tendency
|
|
xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in)
: | $ p $ . 気圧 (整数レベル). Air pressure (full level)
|
|
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
: | $ hat{p} $ . 気圧 (半整数レベル). Air pressure (half level)
|
|
大規模凝結スキームにより, 温度と比湿を調節します.
Adjust temperature and specific humidity by large scale condensation
scheme.
subroutine LScaleCond( xyz_Temp, xyz_QVap, xy_Rain, xyz_DTempDt, xyz_DQVapDt, xyz_Press, xyr_Press )
!
! 大規模凝結スキームにより, 温度と比湿を調節します.
!
! Adjust temperature and specific humidity by
! large scale condensation scheme.
!
! モジュール引用 ; USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: GasRUniv, Grav, CpDry, GasRWet, LatentHeat, EpsV
! $ \epsilon_v $ .
! 水蒸気分子量比.
! Molecular weight of water vapor
! 時刻管理
! Time control
!
use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop
! ヒストリデータ出力
! History data output
!
use gtool_historyauto, only: HistoryAutoPut
! 宣言文 ; Declaration statements
!
implicit none
real(DP), intent(inout):: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
! $ T $ . 温度. Temperature
real(DP), intent(inout):: xyz_QVap (0:imax-1, 1:jmax, 1:kmax)
! $ q $ . 比湿. Specific humidity
real(DP), intent(inout):: xy_Rain (0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP), intent(inout):: xyz_DTempDt (0:imax-1, 1:jmax, 1:kmax)
! 温度変化率.
! Temperature tendency
real(DP), intent(inout):: xyz_DQVapDt (0:imax-1, 1:jmax, 1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP), intent(in):: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
! $ p $ . 気圧 (整数レベル).
! Air pressure (full level)
real(DP), intent(in):: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
! $ \hat{p} $ . 気圧 (半整数レベル).
! Air pressure (half level)
! 作業変数
! Work variables
!
real(DP):: xy_RainLsc (0:imax-1, 1:jmax)
! 降水量.
! Precipitation
real(DP):: xyz_DTempDtLsc (0:imax-1, 1:jmax, 1:kmax)
! 温度変化率.
! Temperature tendency
real(DP):: xyz_DQVapDtLsc (0:imax-1, 1:jmax, 1:kmax)
! 比湿変化率.
! Specific humidity tendency
real(DP):: xyz_QVapB (0:imax-1, 1:jmax, 1:kmax)
! 調節前の比湿.
! Specific humidity before adjust.
real(DP):: xyz_TempB (0:imax-1, 1:jmax, 1:kmax)
! 調節前の温度.
! Temperature before adjust.
!
real(DP):: QVapSat
! 飽和比湿.
! Saturation specific humidity.
real(DP):: DQVapSatDTemp
! $ \DD{q_{\rm{sat}}}{T} $
real(DP):: DelQVap
! 調節による比湿の変化量.
! Specific humidity variation by adjustment
real(DP):: DelTemp
! 調節による温度変化量.
! Temperature variation by adjustment
integer:: i ! 経度方向に回る DO ループ用作業変数
! Work variables for DO loop in longitude
integer:: j ! 緯度方向に回る DO ループ用作業変数
! Work variables for DO loop in latitude
integer:: k ! 鉛直方向に回る DO ループ用作業変数
! Work variables for DO loop in vertical direction
integer:: itr ! イテレーション方向に回る DO ループ用作業変数
! Work variables for DO loop in iteration direction
! 飽和比湿計算のための文関数定義 (CalcQVapSatSF, CalcDQVapSatDTempSF)
! Declaration of statement function for
! calculation of saturation specific humidity
! ("CalcQVapSatSF", "CalcDQVapSatDTempSF")
!
#ifdef LIB_SATURATE_NHA1992
#include "../saturate/saturate_nha1992_sf.f90"
EpsVSF = EpsV
GasRUnivSF = GasRUniv
#elif LIB_SATURATE_T1930
#include "../saturate/saturate_t1930_sf.f90"
EpsVSF = EpsV
LatHeatSF = LatentHeat
GasRWetSF = GasRWet
#else
#include "../saturate/saturate_t1930_sf.f90"
EpsVSF = EpsV
LatHeatSF = LatentHeat
GasRWetSF = GasRWet
#endif
! 実行文 ; Executable statement
!
! 計算時間計測開始
! Start measurement of computation time
!
call TimesetClockStart( module_name )
! 初期化
! Initialization
!
if ( .not. lscond_inited ) call LSCondInit
! 調節前 "QVap", "Temp" の保存
! Store "QVap", "Temp" before adjustment
!
xyz_QVapB = xyz_QVap
xyz_TempB = xyz_Temp
! 調節
! Adjustment
!
do k = kmax, 1, -1
do i = 0, imax-1
do j = 1, jmax
! 飽和比湿計算
! Calculate saturation specific humidity
!
! CalcQVapSatSF は文関数. (実行文の直前で定義)
! "CalcQVapSatSF" is statement function and
! is declared just before executable statement.
!
QVapSat = CalcQVapSatSF( xyz_Temp(i,j,k), xyz_Press(i,j,k) )
! 飽和していたら, 温度と比湿の変化を計算
! Calculate tendency of temperature and humidity
! if moist is saturation.
!
if ( ( xyz_QVap(i,j,k) / QVapSat ) >= CrtlRH ) then
do itr = 1, ItrtMax
! 飽和比湿計算
! Calculate saturation specific humidity
!
! CalcQVapSatSF, CalcDQVapSatDTempSF は文関数. (実行文の直前で定義)
! "CalcQVapSatSF", "CalcDQVapSatDTempSF" is statement function and
! is declared just before executable statement.
!
QVapSat = CalcQVapSatSF( xyz_Temp(i,j,k), xyz_Press(i,j,k) )
DQVapSatDTemp = CalcDQVapSatDTempSF( xyz_Temp(i,j,k), QVapSat )
! 温度と比湿の変化分をニュートン法で求める
! Calculate variation of temperature and specific humidity
! with Newton method
!
DelTemp = LatentHeat / CpDry * ( xyz_QVap(i,j,k) - QVapSat ) / ( 1.0_DP + LatentHeat / CpDry * DQVapSatDTemp )
DelQVap = DQVapSatDTemp * DelTemp
! 温度と比湿の調節
! Adjust temperature and specific humidity
!
xyz_Temp(i,j,k) = xyz_Temp(i,j,k) + DelTemp
xyz_QVap(i,j,k) = QVapSat + DelQVap
end do
end if
end do
end do
end do
! 比湿変化率, 温度変化率, 降水量の算出
! Calculate specific humidity tendency, temperature tendency,
! precipitation
!
xy_RainLsc = 0.
xyz_DTempDtLsc = 0.
xyz_DQvapDtLsc = 0.
xyz_DQVapDtLsc = xyz_DQVapDtLsc + ( xyz_QVap - xyz_QVapB ) / ( 2.0_DP * DelTime )
xyz_DTempDtLsc = xyz_DTempDtLsc + ( xyz_Temp - xyz_TempB ) / ( 2.0_DP * DelTime )
do k = kmax, 1, -1
xy_RainLsc = xy_RainLsc + ( xyz_Temp(:,:,k) - xyz_TempB(:,:,k) ) * CpDry / ( 2.0_DP * DelTime ) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
end do
xy_Rain = xy_Rain + xy_RainLsc
xyz_DTempDt = xyz_DTempDt + xyz_DTempDtLsc
xyz_DQVapDt = xyz_DQVapDt + xyz_DQVapDtLsc
! ヒストリデータ出力
! History data output
!
call HistoryAutoPut( TimeN, 'RainLsc', xy_RainLsc )
call HistoryAutoPut( TimeN, 'DTempDtLsc', xyz_DTempDtLsc )
call HistoryAutoPut( TimeN, 'DQVapDtLsc', xyz_DQVapDtLsc )
! 計算時間計測一時停止
! Pause measurement of computation time
!
call TimesetClockStop( module_name )
end subroutine LScaleCond