Class | mass_fixer |
In: |
util/mass_fixer.f90
|
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fixes masses of constituents. If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixer( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! 成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fixes masses of constituents. ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 座標データ設定 ! Axes data settings ! use axesset, only: x_Lon, y_Lat, z_Sigma ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: IntLonLat_xy ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyz_QMixBefCor (0:imax-1, 1:jmax, 1:kmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_DelConsMass (0:imax-1, 1:jmax, 1:kmax) ! 各層内の成分の質量. ! Mass of constituents in a layer. real(DP):: xyz_DelConsMassRef(0:imax-1, 1:jmax, 1:kmax) ! 積分値を合わせる各層内の成分の質量. ! Reference mass of constituents. real(DP):: xy_ConsMass (0:imax-1, 1:jmax) ! 成分のカラム質量. ! Mass of constituents in a layer. real(DP):: xy_ConsMassRef (0:imax-1, 1:jmax) ! 積分値を合わせる成分のカラム質量. ! Reference mass of constituents in a layer. real(DP):: ConsMass ! 全球の各成分の質量 ! Total mass of constituents real(DP):: ConsMassRef ! 積分値を合わせる全球の各成分の質量 ! Reference total mass of constituents. ! integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! $ \Delta p / g $ の計算 ! Calculate $ \Delta p / g $ ! do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do end if do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculate mass of constituents ! xyz_DelConsMass = xyzf_QMix(:,:,:,n) * xyz_DelMass if ( present( xyzf_QMixRef ) ) then xyz_DelConsMassRef = xyzf_QMixRef(:,:,:,n) * xyz_DelMassRef else xyz_DelConsMassRef = xyz_DelConsMass end if if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if ! 負の質量を直下の層の質量で埋め合わせ. ! Negative mass is removed by filling it with the mass in a layer just below. ! do k = kmax, 2, -1 do j = 1, jmax do i = 0, imax-1 if ( xyz_DelConsMass(i,j,k) < 0.0_DP ) then xyz_DelConsMass(i,j,k-1) = xyz_DelConsMass(i,j,k-1) + xyz_DelConsMass(i,j,k) xyz_DelConsMass(i,j,k ) = 0.0_DP end if end do end do end do k = 1 do j = 1, jmax do i = 0, imax-1 if ( xyz_DelConsMass(i,j,k) < 0.0_DP ) then xyz_DelConsMass(i,j,k) = 0.0_DP end if end do end do ! 全球での補正 ! Correction in globe ! 質量保存のために全体の質量を減少させる. ! Total mass is decreased to conserve mass. ! xy_ConsMass = 0.0_DP xy_ConsMassRef = 0.0_DP do k = kmax, 1, -1 xy_ConsMass = xy_ConsMass + xyz_DelConsMass (:,:,k) xy_ConsMassRef = xy_ConsMassRef + xyz_DelConsMassRef(:,:,k) end do ConsMass = IntLonLat_xy( xy_ConsMass ) ConsMassRef = IntLonLat_xy( xy_ConsMassRef ) if ( ConsMassRef < 0.0_DP ) then if ( ConsMassRef < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'ConsMassRef is less than %f. ' // 'ConsMassRef is reset to zero, n = %d, ConsMassRef = %f.', i = (/ n /), d = (/ ThresholdForMessage, ConsMassRef /) ) end if ConsMassRef = 0.0_DP !!$ call MessageNotify( 'E', module_name, 'ConsMassRef is negative, n = %d.', i = (/ n /) ) end if if ( ConsMass /= 0.0_DP ) then xyz_DelConsMass = ConsMassRef / ConsMass * xyz_DelConsMass else xyz_DelConsMass = 0.0_DP end if xyzf_QMix(:,:,:,n) = xyz_DelConsMass / xyz_DelMass ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if else if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then if ( xyzf_QMix(i,j,k,n) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'Negative at (%f,%f,%f,%d), Val = %f.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, z_Sigma(k), xyzf_QMix(i,j,k,n) /), i = (/ n /) ) end if end if end do end do end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixer
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. See also Diamantakis and Flemming (2014). xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Bermejo and Conde (2002). See also Diamantakis and Flemming (2014). Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerBC02( xyr_Press, xyzf_QMix, xyzf_QMixLin, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. ! See also Diamantakis and Flemming (2014). ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Bermejo and Conde (2002). ! See also Diamantakis and Flemming (2014). ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: IntLonLat_xy ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ) :: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP), parameter:: FactBeta = 1.0_DP ! see Diamantakis and Flemming (2014) real(DP):: Sum real(DP):: xy_Sum (0:imax-1, 1:jmax) real(DP):: xy_SumB(0:imax-1, 1:jmax) real(DP):: xy_SumA(0:imax-1, 1:jmax) real(DP):: f_SumB(1:ncmax) real(DP):: f_SumA(1:ncmax) real(DP), parameter:: MissingValue = -1.0e100_DP real(DP):: f_DelMassTentative(1:ncmax) real(DP):: Lambda real(DP):: SumB real(DP):: SumA real(DP):: Factor integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! !!$ if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then !!$ if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then !!$ call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) !!$ end if !!$ end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference !!$ if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef !!$ else !!$ xyzf_QMixRefLV = xyzf_QMix !!$ end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do !!$ if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do !!$ else !!$ xyz_DelMassRef = xyz_DelMass !!$ end if ! Fill grids with negative values do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) end if end do ! Globally integrated mass do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do f_SumB(n) = IntLonLat_xy( xy_SumB ) f_SumA(n) = IntLonLat_xy( xy_SumA ) else f_SumB(n) = MissingValue f_SumA(n) = MissingValue end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then f_DelMassTentative(n) = f_SumA(n) - f_SumB(n) else f_DelMassTentative(n) = MissingValue end if end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculation of weight xyz_Weight(:,:,:) = max( 0.0_DP, sign( 1.0_DP, f_DelMassTentative(n) ) * ( xyzf_QMix(:,:,:,n) - xyzf_QMixLin(:,:,:,n) )**FactBeta ) ! ! Calculation of factor, lambda ! xy_Sum = 0.0_DP do k = kmax, 1, -1 xy_Sum = xy_Sum + xyz_Weight(:,:,k) * xyz_DelMass(:,:,k) end do Sum = IntLonLat_xy( xy_Sum ) !!$ if ( abs( Sum ) < 1.0e-100_DP ) then if ( abs( Sum ) /= 0.0_DP ) then Lambda = f_DelMassTentative(n) / Sum else Lambda = 0.0_DP end if xyzf_QMix(:,:,:,n) = xyzf_QMix(:,:,:,n) - Lambda * xyz_Weight end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values !!$ ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do SumB = IntLonLat_xy( xy_SumB ) SumA = IntLonLat_xy( xy_SumA ) if ( SumA == 0.0_DP ) then Factor = 0.0_DP else if ( SumA < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02: n = %d, SumA is negative, %f.', i = (/ n /), d = (/ SumA /) ) Factor = 0.0_DP else if ( SumB < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02: n = %d, SumB is negative, %f.', i = (/ n /), d = (/ SumB /) ) Factor = 0.0_DP else Factor = SumB / SumA end if end if xyzf_QMix(:,:,:,n) = Factor * xyzf_QMix(:,:,:,n) end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerBC02
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. See also Diamantakis and Flemming (2014). xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Bermejo and Conde (2002). See also Diamantakis and Flemming (2014). Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerBC02Column( xyr_Press, xyzf_QMix, xyzf_QMixLin, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. ! See also Diamantakis and Flemming (2014). ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Bermejo and Conde (2002). ! See also Diamantakis and Flemming (2014). ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: IntLonLat_xy ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ) :: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP), parameter:: FactBeta = 1.0_DP ! see Diamantakis and Flemming (2014) real(DP):: xy_Sum (0:imax-1, 1:jmax) real(DP):: xyf_SumB(0:imax-1, 1:jmax, 1:ncmax) real(DP):: xyf_SumA(0:imax-1, 1:jmax, 1:ncmax) real(DP):: xy_SumB(0:imax-1, 1:jmax) real(DP):: xy_SumA(0:imax-1, 1:jmax) real(DP), parameter:: MissingValue = -1.0e100_DP real(DP):: xyf_DelMassTentative(0:imax-1, 1:jmax, 1:ncmax) real(DP):: xy_Lambda(0:imax-1, 1:jmax) real(DP):: Factor integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! !!$ if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then !!$ if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then !!$ call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) !!$ end if !!$ end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference !!$ if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef !!$ else !!$ xyzf_QMixRefLV = xyzf_QMix !!$ end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do !!$ if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do !!$ else !!$ xyz_DelMassRef = xyz_DelMass !!$ end if ! Fill grids with negative values do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) end if end do ! Vertically integrated mass do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyf_SumB(:,:,n) = 0.0_DP xyf_SumA(:,:,n) = 0.0_DP do k = kmax, 1, -1 xyf_SumB(:,:,n) = xyf_SumB(:,:,n) + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xyf_SumA(:,:,n) = xyf_SumA(:,:,n) + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do else xyf_SumB(:,:,n) = MissingValue xyf_SumA(:,:,n) = MissingValue end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyf_DelMassTentative(:,:,n) = xyf_SumA(:,:,n) - xyf_SumB(:,:,n) else xyf_DelMassTentative(:,:,n) = MissingValue end if end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculation of weight do k = 1, kmax xyz_Weight(:,:,k) = max( 0.0_DP, sign( 1.0_DP, xyf_DelMassTentative(:,:,n) ) * ( xyzf_QMix(:,:,k,n) - xyzf_QMixLin(:,:,k,n) )**FactBeta ) end do ! ! Calculation of factor, lambda ! xy_Sum = 0.0_DP do k = kmax, 1, -1 xy_Sum = xy_Sum + xyz_Weight(:,:,k) * xyz_DelMass(:,:,k) end do !!$ if ( abs( Sum ) < 1.0e-100_DP ) then do j = 1, jmax do i = 0, imax-1 if ( abs( xy_Sum(i,j) ) /= 0.0_DP ) then xy_Lambda(i,j) = xyf_DelMassTentative(i,j,n) / xy_Sum(i,j) else xy_Lambda(i,j) = 0.0_DP end if end do end do do k = 1, kmax xyzf_QMix(:,:,k,n) = xyzf_QMix(:,:,k,n) - xy_Lambda * xyz_Weight(:,:,k) end do end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values !!$ ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do do j = 1, jmax do i = 0, imax-1 if ( xy_SumA(i,j) == 0.0_DP ) then Factor = 0.0_DP else if ( xy_SumA(i,j) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02Column: n = %d, (i,j) = (%d,%d), SumA is negative, %f.', i = (/ n, i, j /), d = (/ xy_SumA(i,j) /) ) Factor = 0.0_DP else if ( xy_SumB(i,j) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02Column: n = %d, (i,j) = (%d,%d), SumB is negative, %f.', i = (/ n, i, j /), d = (/ xy_SumB(i,j) /) ) Factor = 0.0_DP else Factor = xy_SumB(i,j) / xy_SumA(i,j) end if end if do k = 1, kmax xyzf_QMix(i,j,k,n) = Factor * xyzf_QMix(i,j,k,n) end do end do end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerBC02Column
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in )
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. See also Diamantakis and Flemming (2014). xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Bermejo and Conde (2002). See also Diamantakis and Flemming (2014). Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerBC02Layer( xyr_Press, xyzf_QMix, xyzf_QMixLin, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Bermejo and Conde (2002) の方法に従い, 成分の質量を補正します. ! See also Diamantakis and Flemming (2014). ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Bermejo and Conde (2002). ! See also Diamantakis and Flemming (2014). ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: a_IntLonLat_xya ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyzf_QMixLin(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ) :: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ) :: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP), parameter:: FactBeta = 1.0_DP ! see Diamantakis and Flemming (2014) real(DP):: z_Sum(1:kmax) real(DP):: zf_SumB(1:kmax, 1:ncmax) real(DP):: zf_SumA(1:kmax, 1:ncmax) real(DP), parameter:: MissingValue = -1.0e100_DP real(DP):: zf_DelMassTentative(1:kmax, 1:ncmax) real(DP):: z_Lambda(1:kmax) real(DP):: z_SumB(1:kmax) real(DP):: z_SumA(1:kmax) real(DP):: Factor integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! !!$ if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then !!$ if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then !!$ call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) !!$ end if !!$ end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference !!$ if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef !!$ else !!$ xyzf_QMixRefLV = xyzf_QMix !!$ end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do !!$ if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do !!$ else !!$ xyz_DelMassRef = xyz_DelMass !!$ end if ! Fill grids with negative values do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) end if end do ! Horizontally integrated mass do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then zf_SumB(:,n) = a_IntLonLat_xya( xyzf_QMixRefLV(:,:,:,n) * xyz_DelMassRef ) zf_SumA(:,n) = a_IntLonLat_xya( xyzf_QMix (:,:,:,n) * xyz_DelMass ) else zf_SumB(:,n) = MissingValue zf_SumA(:,n) = MissingValue end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then zf_DelMassTentative(:,n) = zf_SumA(:,n) - zf_SumB(:,n) else zf_DelMassTentative(:,n) = MissingValue end if end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculation of weight do k = 1, kmax xyz_Weight(:,:,k) = max( 0.0_DP, sign( 1.0_DP, zf_DelMassTentative(k,n) ) * ( xyzf_QMix(:,:,k,n) - xyzf_QMixLin(:,:,k,n) )**FactBeta ) end do ! ! Calculation of factor, lambda ! z_Sum = a_IntLonLat_xya( xyz_Weight * xyz_DelMass ) !!$ if ( abs( Sum ) < 1.0e-100_DP ) then do k = 1, kmax if ( abs( z_Sum(k) ) /= 0.0_DP ) then z_Lambda(k) = zf_DelMassTentative(k,n) / z_Sum(k) else z_Lambda(k) = 0.0_DP end if end do do k = 1, kmax xyzf_QMix(:,:,k,n) = xyzf_QMix(:,:,k,n) - z_Lambda(k) * xyz_Weight(:,:,k) end do end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values !!$ ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) z_SumB = a_IntLonLat_xya( xyzf_QMixRefLV(:,:,:,n) * xyz_DelMassRef ) z_SumA = a_IntLonLat_xya( xyzf_QMix (:,:,:,n) * xyz_DelMass ) do k = 1, kmax if ( z_SumA(k) == 0.0_DP ) then Factor = 0.0_DP else if ( z_SumA(k) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02Layer: n = %d, k = %d, SumA is negative, %f.', i = (/ n, k /), d = (/ z_SumA(k) /) ) Factor = 0.0_DP else if ( z_SumB(k) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'BC02Layer: n = %d, k = %d, SumB is negative, %f.', i = (/ n, k /), d = (/ z_SumB(k) /) ) Factor = 0.0_DP else Factor = z_SumB(k) / z_SumA(k) end if end if xyzf_QMix(:,:,k,n) = Factor * xyzf_QMix(:,:,k,n) end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerBC02Layer
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
鉛直カラム内で成分の質量を補正します. xyzf_QMixRef が与えられた場合には, カラム積分値が xyzf_QMixRef の それと同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fixes masses of constituents in each vertical column. If xyzf_QMixRef is given, the mass is fixed to match its column integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its column integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerColumn( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! 鉛直カラム内で成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, カラム積分値が *xyzf_QMixRef* の ! それと同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fixes masses of constituents in each vertical column. ! If *xyzf_QMixRef* is given, the mass is fixed to match its column ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its column ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 座標データ設定 ! Axes data settings ! use axesset, only: x_Lon, y_Lat, z_Sigma ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyz_QMixBefCor (0:imax-1, 1:jmax, 1:kmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_DelConsMass (0:imax-1, 1:jmax, 1:kmax) ! 各層内の成分の質量. ! Mass of constituents in a layer. real(DP):: xyz_DelConsMassRef(0:imax-1, 1:jmax, 1:kmax) ! 積分値を合わせる各層内の成分の質量. ! Reference mass of constituents. real(DP):: xy_ConsMass (0:imax-1, 1:jmax) ! 成分のカラム質量. ! Mass of constituents in a layer. real(DP):: xy_ConsMassRef (0:imax-1, 1:jmax) ! 積分値を合わせる成分のカラム質量. ! Reference mass of constituents in a layer. integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! $ \Delta p / g $ の計算 ! Calculate $ \Delta p / g $ ! do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do end if do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculate mass of constituents ! xyz_DelConsMass = xyzf_QMix(:,:,:,n) * xyz_DelMass if ( present( xyzf_QMixRef ) ) then xyz_DelConsMassRef = xyzf_QMixRef(:,:,:,n) * xyz_DelMassRef else xyz_DelConsMassRef = xyz_DelConsMass end if if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if ! 負の質量を直下の層の質量で埋め合わせ. ! Negative mass is removed by filling it with the mass in a layer just below. ! do k = kmax, 2, -1 do j = 1, jmax do i = 0, imax-1 if ( xyz_DelConsMass(i,j,k) < 0.0_DP ) then xyz_DelConsMass(i,j,k-1) = xyz_DelConsMass(i,j,k-1) + xyz_DelConsMass(i,j,k) xyz_DelConsMass(i,j,k ) = 0.0_DP end if end do end do end do k = 1 do j = 1, jmax do i = 0, imax-1 if ( xyz_DelConsMass(i,j,k) < 0.0_DP ) then xyz_DelConsMass(i,j,k) = 0.0_DP end if end do end do ! 全球での補正 ! Correction in globe ! 質量保存のために全体の質量を減少させる. ! Total mass is decreased to conserve mass. ! xy_ConsMass = 0.0_DP xy_ConsMassRef = 0.0_DP do k = kmax, 1, -1 xy_ConsMass = xy_ConsMass + xyz_DelConsMass (:,:,k) xy_ConsMassRef = xy_ConsMassRef + xyz_DelConsMassRef(:,:,k) end do do j = 1, jmax do i = 0, imax-1 if ( xy_ConsMassRef(i,j) < 0.0_DP ) then if ( xy_ConsMassRef(i,j) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'xy_ConsMassRef(%f,%f) is less than %f. ' // 'The value, %f, is reset to zero, n = %d.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, ThresholdForMessage, xy_ConsMassRef(i,j) /), i = (/ n /) ) end if xy_ConsMassRef(i,j) = 0.0_DP !!$ call MessageNotify( 'E', module_name, 'ConsMassRef is negative, n = %d.', i = (/ n /) ) end if if ( xy_ConsMass(i,j) /= 0.0_DP ) then do k = 1, kmax xyz_DelConsMass(i,j,k) = xy_ConsMassRef(i,j) / xy_ConsMass(i,j) * xyz_DelConsMass(i,j,k) end do else do k = 1, kmax xyz_DelConsMass(i,j,k) = 0.0_DP end do end if end do end do xyzf_QMix(:,:,:,n) = xyz_DelConsMass / xyz_DelMass ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = xyzf_DQMixDt(:,:,:,n) + ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if else if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then if ( xyzf_QMix(i,j,k,n) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'Column: Negative at (%f,%f,%f,%d), Val = %f.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, z_Sigma(k), xyzf_QMix(i,j,k,n) /), i = (/ n /) ) end if end if end do end do end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerColumn
Subroutine : |
mass_fixer モジュールの初期化を行います. NAMELIST#mass_fixer_nml の読み込みはこの手続きで行われます.
"mass_fixer" module is initialized. "NAMELIST#mass_fixer_nml" is loaded in this procedure.
This procedure input/output NAMELIST#mass_fixer_nml .
subroutine MassFixerInit ! ! mass_fixer モジュールの初期化を行います. ! NAMELIST#mass_fixer_nml の読み込みはこの手続きで行われます. ! ! "mass_fixer" module is initialized. ! "NAMELIST#mass_fixer_nml" is loaded in this procedure. ! ! モジュール引用 ; USE statements ! ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_filename, NmlutilMsg ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output ! 文字列操作 ! Character handling ! use dc_string, only: StoA ! 宣言文 ; Declaration statements ! implicit none integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read ! NAMELIST 変数群 ! NAMELIST group name ! namelist /mass_fixer_nml/ ThresholdForMessage ! ! デフォルト値については初期化手続 "mass_fixer#MassFixerInit" ! のソースコードを参照のこと. ! ! Refer to source codes in the initialization procedure ! "mass_fixer#MassFixerInit" for the default values. ! ! 実行文 ; Executable statement ! if ( mass_fixer_inited ) return ! デフォルト値の設定 ! Default values settings ! ThresholdForMessage = 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 = mass_fixer_nml, iostat = iostat_nml ) ! (out) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) end if ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, ' ThresholdForMessage = %f', d = (/ ThresholdForMessage /) ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) mass_fixer_inited = .true. end subroutine MassFixerInit
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
鉛直層内で成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fixes masses of constituents in each vertical layer. If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerLayer( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! 鉛直層内で成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fixes masses of constituents in each vertical layer. ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 座標データ設定 ! Axes data settings ! use axesset, only: x_Lon, y_Lat, z_Sigma ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: a_IntLonLat_xya ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyz_QMixBefCor (0:imax-1, 1:jmax, 1:kmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_DelConsMass (0:imax-1, 1:jmax, 1:kmax) ! 各層内の成分の質量. ! Mass of constituents in a layer. real(DP):: xyz_DelConsMassRef(0:imax-1, 1:jmax, 1:kmax) ! 積分値を合わせる各層内の成分の質量. ! Reference mass of constituents. real(DP):: z_ConsMass (1:kmax) ! 全球の各成分の質量 ! Total mass of constituents real(DP):: z_ConsMassRef(1:kmax) ! 積分値を合わせる全球の各成分の質量 ! Reference total mass of constituents. ! integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! $ \Delta p / g $ の計算 ! Calculate $ \Delta p / g $ ! do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do end if do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! Calculate mass of constituents ! xyz_DelConsMass = xyzf_QMix(:,:,:,n) * xyz_DelMass if ( present( xyzf_QMixRef ) ) then xyz_DelConsMassRef = xyzf_QMixRef(:,:,:,n) * xyz_DelMassRef else xyz_DelConsMassRef = xyz_DelConsMass end if if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyz_DelConsMass(i,j,k) < 0.0_DP ) then xyz_DelConsMass(i,j,k) = 0.0_DP end if end do end do end do ! 各層での補正 ! Correction in each layer ! 質量保存のために全体の質量を減少させる. ! Total mass is decreased to conserve mass. ! z_ConsMass = a_IntLonLat_xya( xyz_DelConsMass ) z_ConsMassRef = a_IntLonLat_xya( xyz_DelConsMassRef ) do k = 1, kmax if ( z_ConsMassRef(k) < 0.0_DP ) then if ( z_ConsMassRef(k) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'z_ConsMassRef(%f) is less than %f. ' // 'z_ConsMassRef is reset to zero, n = %d, z_ConsMassRef = %f.', d = (/ z_Sigma(k), ThresholdForMessage, z_ConsMassRef(k) /), i = (/ n /) ) end if z_ConsMassRef(k) = 0.0_DP !!$ call MessageNotify( 'E', module_name, 'ConsMassRef is negative, n = %d.', i = (/ n /) ) end if if ( z_ConsMass(k) /= 0.0_DP ) then xyz_DelConsMass(:,:,k) = z_ConsMassRef(k) / z_ConsMass(k) * xyz_DelConsMass(:,:,k) else xyz_DelConsMass(:,:,k) = 0.0_DP end if end do xyzf_QMix(:,:,:,n) = xyz_DelConsMass / xyz_DelMass ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = xyzf_DQMixDt(:,:,:,n) + ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if else if ( present( xyzf_DQMixDt ) ) then xyz_QMixBefCor = xyzf_QMix(:,:,:,n) end if xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt(:,:,:,n) = ( xyzf_QMix(:,:,:,n) - xyz_QMixBefCor ) / ( 2.0_DP * DelTime ) end if end if end do do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then if ( xyzf_QMix(i,j,k,n) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'Layer: Negative at (%f,%f,%f,%d), Val = %f.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, z_Sigma(k), xyzf_QMix(i,j,k,n)/), i = (/ n /) ) end if end if end do end do end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerLayer
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Rasch et al. (1995) の方法に従い, 成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Rasch et al. (1995). If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerR95( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Rasch et al. (1995) の方法に従い, 成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Rasch et al. (1995). ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: IntLonLat_xy ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP):: xy_FactAlphaNumer(0:imax-1, 1:jmax) real(DP):: xy_FactAlphaDenom(0:imax-1, 1:jmax) real(DP):: FactAlphaNumer real(DP):: FactAlphaDenom real(DP):: FactAlpha real(DP), parameter:: FactBeta = 1.0_DP ! for Rasch et al. (1994) real(DP):: xy_SumB(0:imax-1, 1:jmax) real(DP):: xy_SumA(0:imax-1, 1:jmax) real(DP):: SumB real(DP):: SumA real(DP):: Factor integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef else xyzf_QMixRefLV = xyzf_QMix end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do else xyz_DelMassRef = xyz_DelMass end if ! Fill grids with negative values xyzf_QMix = max( xyzf_QMix, 0.0_DP ) ! Calculation of weight (pressure) do k = 1, kmax xyz_Weight(:,:,k) = ( xyr_Press(:,:,k-1) + xyr_Press(:,:,k) ) / 2.0_DP end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! ! Calculation of factor, alpha ! xy_FactAlphaNumer = 0.0_DP xy_FactAlphaDenom = 0.0_DP do k = kmax, 1, -1 xy_FactAlphaNumer = xy_FactAlphaNumer + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) - xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) xy_FactAlphaDenom = xy_FactAlphaDenom + xyz_Weight (:,:,k) * xyzf_QMix (:,:,k,n) * abs( xyzf_QMix(:,:,k,n) - xyzf_QMixRefLV(:,:,k,n) )**FactBeta * xyz_DelMass(:,:,k) end do FactAlphaNumer = IntLonLat_xy( xy_FactAlphaNumer ) FactAlphaDenom = IntLonLat_xy( xy_FactAlphaDenom ) if ( FactAlphaDenom /= 0.0_DP ) then FactAlpha = FactAlphaNumer / FactAlphaDenom else FactAlpha = 0.0_DP end if xyzf_QMix(:,:,:,n) = xyzf_QMix(:,:,:,n) + FactAlpha * xyz_Weight * xyzf_QMix(:,:,:,n) * abs( xyzf_QMix(:,:,:,n) - xyzf_QMixRefLV(:,:,:,n) )**FactBeta end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do SumB = IntLonLat_xy( xy_SumB ) SumA = IntLonLat_xy( xy_SumA ) if ( SumA == 0.0_DP ) then Factor = 0.0_DP else if ( SumA < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumA is negative, %f.', i = (/ n /), d = (/ SumA /) ) Factor = 0.0_DP else if ( SumB < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumB is negative, %f.', i = (/ n /), d = (/ SumB /) ) Factor = 0.0_DP else Factor = SumB / SumA end if end if xyzf_QMix(:,:,:,n) = Factor * xyzf_QMix(:,:,:,n) end if end do !!$ ! This is not required. !!$ do n = 1, ncmax !!$ if ( CompositionInqFlagMassFix( n ) ) then !!$ do k = 1, kmax !!$ do j = 1, jmax !!$ do i = 0, imax-1 !!$ if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then !!$ call MessageNotify( 'M', module_name, & !!$ & 'R95: Negative at (%f,%f,%f,%d), Val = %f.', & !!$ & d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, & !!$ & z_Sigma(k), xyzf_QMix(i,j,k,n) /), & !!$ & i = (/ n /) ) !!$ end if !!$ end do !!$ end do !!$ end do !!$ end if !!$ end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerR95
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Rasch et al. (1995) の方法に従い, 成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Rasch et al. (1995). If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerR95Column( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Rasch et al. (1995) の方法に従い, 成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Rasch et al. (1995). ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP):: xy_FactAlphaNumer(0:imax-1, 1:jmax) real(DP):: xy_FactAlphaDenom(0:imax-1, 1:jmax) real(DP):: xy_FactAlpha(0:imax-1, 1:jmax) real(DP), parameter:: FactBeta = 1.0_DP ! for Rasch et al. (1994) real(DP):: xy_SumB(0:imax-1, 1:jmax) real(DP):: xy_SumA(0:imax-1, 1:jmax) real(DP):: xy_Factor(0:imax-1, 1:jmax) integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef else xyzf_QMixRefLV = xyzf_QMix end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do else xyz_DelMassRef = xyz_DelMass end if ! Fill grids with negative values xyzf_QMix = max( xyzf_QMix, 0.0_DP ) ! Calculation of weight (pressure) do k = 1, kmax xyz_Weight(:,:,k) = ( xyr_Press(:,:,k-1) + xyr_Press(:,:,k) ) / 2.0_DP end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! ! Calculation of factor, alpha ! xy_FactAlphaNumer = 0.0_DP xy_FactAlphaDenom = 0.0_DP do k = kmax, 1, -1 xy_FactAlphaNumer = xy_FactAlphaNumer + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) - xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) xy_FactAlphaDenom = xy_FactAlphaDenom + xyz_Weight (:,:,k) * xyzf_QMix (:,:,k,n) * abs( xyzf_QMix(:,:,k,n) - xyzf_QMixRefLV(:,:,k,n) )**FactBeta * xyz_DelMass(:,:,k) end do do j = 1, jmax do i = 0, imax-1 if ( xy_FactAlphaDenom(i,j) /= 0.0_DP ) then xy_FactAlpha(i,j) = xy_FactAlphaNumer(i,j) / xy_FactAlphaDenom(i,j) else xy_FactAlpha(i,j) = 0.0_DP end if end do end do do k = 1, kmax xyzf_QMix(:,:,k,n) = xyzf_QMix(:,:,k,n) + xy_FactAlpha * xyz_Weight(:,:,k) * xyzf_QMix(:,:,k,n) * abs( xyzf_QMix(:,:,k,n) - xyzf_QMixRefLV(:,:,k,n) )**FactBeta end do end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do do j = 1, jmax do i = 0, imax-1 if ( xy_SumA(i,j) == 0.0_DP ) then xy_Factor(i,j) = 0.0_DP else if ( xy_SumA(i,j) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumA is negative, %f.', i = (/ n /), d = (/ xy_SumA(i,j) /) ) xy_Factor(i,j) = 0.0_DP else if ( xy_SumB(i,j) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumB is negative, %f.', i = (/ n /), d = (/ xy_SumB(i,j) /) ) xy_Factor(i,j) = 0.0_DP else xy_Factor(i,j) = xy_SumB(i,j) / xy_SumA(i,j) end if end if end do end do do k = 1, kmax xyzf_QMix(:,:,k,n) = xy_Factor * xyzf_QMix(:,:,k,n) end do end if end do !!$ ! This is not required. !!$ do n = 1, ncmax !!$ if ( CompositionInqFlagMassFix( n ) ) then !!$ do k = 1, kmax !!$ do j = 1, jmax !!$ do i = 0, imax-1 !!$ if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then !!$ call MessageNotify( 'M', module_name, & !!$ & 'R95: Negative at (%f,%f,%f,%d), Val = %f.', & !!$ & d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, & !!$ & z_Sigma(k), xyzf_QMix(i,j,k,n) /), & !!$ & i = (/ n /) ) !!$ end if !!$ end do !!$ end do !!$ end do !!$ end if !!$ end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerR95Column
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Rasch et al. (1995) の方法に従い, 成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Rasch et al. (1995). If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerR95Layer( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Rasch et al. (1995) の方法に従い, 成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Rasch et al. (1995). ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: a_IntLonLat_xya ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xyz_Weight (0:imax-1, 1:jmax, 1:kmax) real(DP):: xyz_FactAlphaNumer(0:imax-1, 1:jmax, 1:kmax) real(DP):: xyz_FactAlphaDenom(0:imax-1, 1:jmax, 1:kmax) real(DP):: z_FactAlphaNumer(1:kmax) real(DP):: z_FactAlphaDenom(1:kmax) real(DP):: z_FactAlpha (1:kmax) real(DP), parameter:: FactBeta = 1.0_DP ! for Rasch et al. (1994) real(DP):: xyz_SumB(0:imax-1, 1:jmax, 1:kmax) real(DP):: xyz_SumA(0:imax-1, 1:jmax, 1:kmax) real(DP):: z_SumB(1:kmax) real(DP):: z_SumA(1:kmax) real(DP):: z_Factor(1:kmax) integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef else xyzf_QMixRefLV = xyzf_QMix end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do else xyz_DelMassRef = xyz_DelMass end if ! Fill grids with negative values xyzf_QMix = max( xyzf_QMix, 0.0_DP ) ! Calculation of weight (pressure) do k = 1, kmax xyz_Weight(:,:,k) = ( xyr_Press(:,:,k-1) + xyr_Press(:,:,k) ) / 2.0_DP end do ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! ! Calculation of factor, alpha ! xyz_FactAlphaNumer = + xyzf_QMixRefLV(:,:,:,n) * xyz_DelMassRef - xyzf_QMix (:,:,:,n) * xyz_DelMass xyz_FactAlphaDenom = + xyz_Weight * xyzf_QMix (:,:,:,n) * abs( xyzf_QMix(:,:,:,n) - xyzf_QMixRefLV(:,:,:,n) )**FactBeta * xyz_DelMass z_FactAlphaNumer = a_IntLonLat_xya( xyz_FactAlphaNumer ) z_FactAlphaDenom = a_IntLonLat_xya( xyz_FactAlphaDenom ) do k = 1, kmax if ( z_FactAlphaDenom(k) /= 0.0_DP ) then z_FactAlpha(k) = z_FactAlphaNumer(k) / z_FactAlphaDenom(k) else z_FactAlpha(k) = 0.0_DP end if end do do k = 1, kmax xyzf_QMix(:,:,k,n) = xyzf_QMix(:,:,k,n) + z_FactAlpha(k) * xyz_Weight(:,:,k) * xyzf_QMix(:,:,k,n) * abs( xyzf_QMix(:,:,k,n) - xyzf_QMixRefLV(:,:,k,n) )**FactBeta end do end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values ! This procedure is not included in Rasch et al. (1995). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xyz_SumB = xyzf_QMixRefLV(:,:,:,n) * xyz_DelMassRef xyz_SumA = xyzf_QMix (:,:,:,n) * xyz_DelMass z_SumB = a_IntLonLat_xya( xyz_SumB ) z_SumA = a_IntLonLat_xya( xyz_SumA ) do k = 1, kmax if ( z_SumA(k) == 0.0_DP ) then z_Factor(k) = 0.0_DP else if ( z_SumA(k) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumA is negative, %f.', i = (/ n /), d = (/ z_SumA(k) /) ) z_Factor(k) = 0.0_DP else if ( z_SumB(k) < 0.0_DP ) then call MessageNotify( 'M', module_name, 'R95: n = %d, SumB is negative, %f.', i = (/ n /), d = (/ z_SumB(k) /) ) z_Factor(k) = 0.0_DP else z_Factor(k) = z_SumB(k) / z_SumA(k) end if end if end do do k = 1, kmax xyzf_QMix(:,:,k,n) = z_Factor(k) * xyzf_QMix(:,:,k,n) end do end if end do !!$ ! This is not required. !!$ do n = 1, ncmax !!$ if ( CompositionInqFlagMassFix( n ) ) then !!$ do k = 1, kmax !!$ do j = 1, jmax !!$ do i = 0, imax-1 !!$ if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then !!$ call MessageNotify( 'M', module_name, & !!$ & 'R95: Negative at (%f,%f,%f,%d), Val = %f.', & !!$ & d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, & !!$ & z_Sigma(k), xyzf_QMix(i,j,k,n) /), & !!$ & i = (/ n /) ) !!$ end if !!$ end do !!$ end do !!$ end do !!$ end if !!$ end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerR95Layer
Subroutine : | |||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in )
| ||
xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(inout)
| ||
xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ), optional
| ||
xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(in ), optional
| ||
xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) : | real(DP), intent(out ), optional
|
Williamson and Olson (1994) の方法に従い, 成分の質量を補正します. xyzf_QMixRef が与えられた場合には, 全球積分値が xyzf_QMixRef のそれと 同じになるように補正します. xyzf_QMixRef が与えられない場合には, 全球積分値が補正前のそれと 同じになるように補正します. xyzf_DQMixDt には xyz_QMix の変化量が返ります.
This routine fix masses of constituents following a method proposed by Williamson and Olson (1994). If xyzf_QMixRef is given, the mass is fixed to match its global integrated value is the same as that of xyzf_QMixRef. If xyzf_QMixRef is not given, the mass is fixed to match its global integrated value is the same as that of pre-fixed value. Variation of xyzf_QMix is returned to xyz_DQMixDt.
subroutine MassFixerWO94( xyr_Press, xyzf_QMix, xyr_PressRef, xyzf_QMixRef, xyzf_DQMixDt ) ! ! Williamson and Olson (1994) の方法に従い, 成分の質量を補正します. ! *xyzf_QMixRef* が与えられた場合には, 全球積分値が *xyzf_QMixRef* のそれと ! 同じになるように補正します. ! *xyzf_QMixRef* が与えられない場合には, 全球積分値が補正前のそれと ! 同じになるように補正します. ! *xyzf_DQMixDt* には *xyz_QMix* の変化量が返ります. ! ! This routine fix masses of constituents following a method proposed by ! Williamson and Olson (1994). ! If *xyzf_QMixRef* is given, the mass is fixed to match its global ! integrated value is the same as that of *xyzf_QMixRef*. ! If *xyzf_QMixRef* is not given, the mass is fixed to match its global ! integrated value is the same as that of pre-fixed value. ! Variation of *xyzf_QMix* is returned to *xyz_DQMixDt*. ! ! モジュール引用 ; USE statements ! ! 物理・数学定数設定 ! Physical and mathematical constants settings ! use constants0, only: PI ! $ \pi $. ! 円周率. Circular constant ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 座標データ設定 ! Axes data settings ! use axesset, only: x_Lon, y_Lat, z_Sigma ! 積分と平均の操作 ! Operation for integral and average ! use intavr_operate, only: IntLonLat_xy ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimesetClockStart, TimesetClockStop ! 組成に関わる配列の設定 ! Settings of array for atmospheric composition ! use composition, only: CompositionInqFlagMassFix ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in ) :: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(inout) :: xyzf_QMix (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in ), optional:: xyr_PressRef(0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in ), optional:: xyzf_QMixRef(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q \Delta p / g $ . 積分値を合わせる層内の成分の質量. ! Reference specific mass of constituent in a layer real(DP), intent(out ), optional:: xyzf_DQMixDt(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ \DP{q}{t} $ . 比湿補正率. ! Specific humidity correction ! 作業変数 ! Work variables ! real(DP):: xyzf_QMixRefLV(0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! $ q $ . 層内の成分の混合比. ! Reference specific mass of constituent (local value) real(DP):: xyzf_QMixBefCor (0:imax-1, 1:jmax, 1:kmax, 1:ncmax) ! 修正前の比湿. ! Specific humidity before correction. real(DP):: xyz_DelMass (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ ! real(DP):: xyz_DelMassRef (0:imax-1, 1:jmax, 1:kmax) ! $ \Delta p / g $ of reference ! real(DP):: xy_FactAlphaNumer(0:imax-1, 1:jmax) real(DP):: xy_FactAlphaDenom(0:imax-1, 1:jmax) real(DP):: FactAlphaNumer real(DP):: FactAlphaDenom real(DP):: FactAlpha real(DP), parameter:: FactBeta = 1.5_DP real(DP):: xy_SumB(0:imax-1, 1:jmax) real(DP):: xy_SumA(0:imax-1, 1:jmax) real(DP):: SumB real(DP):: SumA real(DP):: Factor integer:: i ! 経度方向に回る DO ループ用作業変数 ! Work variables for DO loop in longitudinal direction integer:: j ! 緯度方向に回る DO ループ用作業変数 ! Work variables for DO loop in latitudinal direction integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: n ! 組成方向に回る DO ループ用作業変数 ! Work variables for DO loop in dimension of constituents ! 実行文 ; Executable statement ! ! 初期化確認 ! Initialization check ! if ( .not. mass_fixer_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 arguments ! if ( present( xyr_PressRef ) .or. present( xyzf_QMixRef ) ) then if ( .not. ( present( xyr_PressRef ) .and. present( xyzf_QMixRef ) ) ) then call MessageNotify( 'E', module_name, 'If xyr_PressRef or xyzf_QMixRef is given, both have to be given.' ) end if end if ! Backup of a variable if ( present( xyzf_DQMixDt ) ) then xyzf_QMixBefCor = xyzf_QMix end if ! Preparation of variable for reference if ( present( xyzf_QMixRef ) ) then xyzf_QMixRefLV = xyzf_QMixRef else xyzf_QMixRefLV = xyzf_QMix end if do k = 1, kmax xyz_DelMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav end do if ( present( xyr_PressRef ) ) then do k = 1, kmax xyz_DelMassRef(:,:,k) = ( xyr_PressRef(:,:,k-1) - xyr_PressRef(:,:,k) ) / Grav end do else xyz_DelMassRef = xyz_DelMass end if ! Fill grids with negative values xyzf_QMix = max( xyzf_QMix, 0.0_DP ) ! loop for constituents do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then ! ! Calculation of factor, alpha ! xy_FactAlphaNumer = 0.0_DP xy_FactAlphaDenom = 0.0_DP do k = kmax, 1, -1 xy_FactAlphaNumer = xy_FactAlphaNumer + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) - xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) xy_FactAlphaDenom = xy_FactAlphaDenom + xyzf_QMix (:,:,k,n) * abs( xyzf_QMix(:,:,k,n) - xyzf_QMixRefLV(:,:,k,n) )**FactBeta * xyz_DelMass(:,:,k) end do FactAlphaNumer = IntLonLat_xy( xy_FactAlphaNumer ) FactAlphaDenom = IntLonLat_xy( xy_FactAlphaDenom ) if ( FactAlphaDenom /= 0.0_DP ) then FactAlpha = FactAlphaNumer / FactAlphaDenom else FactAlpha = 0.0_DP end if xyzf_QMix(:,:,:,n) = xyzf_QMix(:,:,:,n) + FactAlpha * xyzf_QMix(:,:,:,n) * abs( xyzf_QMix(:,:,:,n) - xyzf_QMixRefLV(:,:,:,n) )**FactBeta end if end do ! 比湿変化の算出 ! Calculate specific humidity variance ! if ( present( xyzf_DQMixDt ) ) then xyzf_DQMixDt = ( xyzf_QMix - xyzf_QMixBefCor ) / ( 2.0_DP * DelTime ) end if ! Ensure non-negative values ! This procedure is not included in Williams and Olson (1994). do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then xyzf_QMix(:,:,:,n) = max( xyzf_QMix(:,:,:,n), 0.0_DP ) xy_SumB = 0.0_DP xy_SumA = 0.0_DP do k = kmax, 1, -1 xy_SumB = xy_SumB + xyzf_QMixRefLV(:,:,k,n) * xyz_DelMassRef(:,:,k) xy_SumA = xy_SumA + xyzf_QMix (:,:,k,n) * xyz_DelMass (:,:,k) end do SumB = IntLonLat_xy( xy_SumB ) SumA = IntLonLat_xy( xy_SumA ) if ( SumA == 0.0_DP ) then Factor = 0.0_DP else if ( SumA < 0.0_DP ) then call MessageNotify( 'M', module_name, 'WO94: n = %d, SumA is negative, %f.', i = (/ n /), d = (/ SumA /) ) Factor = 0.0_DP else if ( SumB < 0.0_DP ) then call MessageNotify( 'M', module_name, 'WO94: n = %d, SumB is negative, %f.', i = (/ n /), d = (/ SumB /) ) Factor = 0.0_DP else Factor = SumB / SumA end if end if xyzf_QMix(:,:,:,n) = Factor * xyzf_QMix(:,:,:,n) end if end do ! This is not required. do n = 1, ncmax if ( CompositionInqFlagMassFix( n ) ) then do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if ( xyzf_QMix(i,j,k,n) < 0.0_DP ) then if ( xyzf_QMix(i,j,k,n) < ThresholdForMessage ) then call MessageNotify( 'M', module_name, 'WO94: Negative at (%f,%f,%f,%d), Val = %f.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, z_Sigma(k), xyzf_QMix(i,j,k,n) /), i = (/ n /) ) end if end if end do end do end do end if end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine MassFixerWO94
Variable : | |||
mass_fixer_inited = .false. : | logical, save
|
Constant : | |||
version = ’$Name: $’ // ’$Id: mass_fixer.f90,v 1.14 2014/06/29 07:20:43 yot Exp $’ : | character(*), parameter
|