| 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
call MessageNotify( 'M', module_name, 'ConsMassRef is negative. ' // 'ConsMassRef is reset to zero, n = %d, ConsMassRef = %f.', i = (/ n /), d = (/ ConsMassRef /) )
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
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 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)
| ||
| 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
call MessageNotify( 'M', module_name, 'xy_ConsMassRef(%f,%f) is negative. ' // 'The value, %f, is reset to zero, n = %d.', d = (/ x_Lon(i)*180.0_DP/PI, y_Lat(j)*180.0_DP/PI, xy_ConsMassRef(i,j) /), i = (/ n /) )
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
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 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.
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/
!
! デフォルト値については初期化手続 "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
!
!!$ ! NAMELIST の読み込み
!!$ ! NAMELIST is input
!!$ !
!!$ if ( trim(namelist_filename) /= '' ) then
!!$ call FileOpen( unit_nml, & ! (out)
!!$ & namelist_filename, mode = 'r' ) ! (in)
!!$
!!$ rewind( unit_nml )
!!$ read( unit_nml, & ! (in)
!!$ & nml = mass_fixer_nml, & ! (out)
!!$ & 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, '-- 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
call MessageNotify( 'M', module_name, 'z_ConsMassRef(%f) is negative. ' // 'z_ConsMassRef is reset to zero, n = %d, z_ConsMassRef = %f.', d = (/ z_Sigma(k), z_ConsMassRef(k) /), i = (/ n /) )
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
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 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
! 座標データ設定
! 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):: 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:: 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
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
! 座標データ設定
! 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):: 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
! 座標データ設定
! 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):: 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:: 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
!
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
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 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: dcpam5-20150131 $’ // ’$Id: mass_fixer.f90,v 1.14 2014/06/29 07:20:43 yot Exp $’ : | character(*), parameter
|