Class | radiation_DennouAGCM |
In: |
radiation/radiation_DennouAGCM.F90
|
Note that Japanese and English are described in parallel.
温度, 比湿, 気圧から, 放射フラックスを計算する放射モデルです.
This is a radiation model that calculates radiation flux from temperature, specific humidity, and air pressure.
RadiationFluxDennouAGCM : | 放射フラックスの計算 |
RadiationDTempDt : | 放射フラックスによる温度変化の計算 |
RadiationFluxOutput : | 放射フラックスの出力 |
RadiationFinalize : | 終了処理 (モジュール内部の変数の割り付け解除) |
———— : | ———— |
RadiationFluxDennouAGCM : | Calculate radiation flux |
RadiationDTempDt : | Calculate temperature tendency with radiation flux |
RadiationFluxOutput : | Output radiation fluxes |
RadiationFinalize : | Termination (deallocate variables in this module) |
Subroutine : | |||
xyr_RadLFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_RadSFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyz_DTempDtRadL(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out)
| ||
xyz_DTempDtRadS(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(out)
|
放射による温度変化率を計算します.
Temperature tendency with radiation is calculated.
subroutine RadiationDTempDt( xyr_RadLFlux, xyr_RadSFlux, xyr_Press, xyz_DTempDtRadL, xyz_DTempDtRadS ) ! ! 放射による温度変化率を計算します. ! ! Temperature tendency with radiation is calculated. ! ! モジュール引用 ; USE statements ! ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav, CpDry ! $ C_p $ [J kg-1 K-1]. ! 乾燥大気の定圧比熱. ! Specific heat of air at constant pressure ! 時刻管理 ! Time control ! use timeset, only: TimeN, TimesetClockStart, TimesetClockStop ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in):: xyr_RadLFlux (0:imax-1, 1:jmax, 0:kmax) ! 長波フラックス. ! Longwave flux real(DP), intent(in):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax) ! 短波 (日射) フラックス. ! Shortwave (insolation) flux real(DP), intent(in):: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(out):: xyz_DTempDtRadL (0:imax-1, 1:jmax, 1:kmax) ! 長波加熱率. ! Temperature tendency with longwave real(DP), intent(out):: xyz_DTempDtRadS (0:imax-1, 1:jmax, 1:kmax) ! 短波加熱率. ! Temperature tendency with shortwave ! 作業変数 ! Work variables ! integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction ! 実行文 ; Executable statement ! ! 計算時間計測開始 ! Start measurement of computation time ! call TimesetClockStart( module_name ) ! 初期化 ! Initialization ! if ( .not. radiation_DennouAGCM_inited ) call RadiationInit ! 放射冷却率の演算 ! Calculate radiation cooling rate ! do k = 1, kmax xyz_DTempDtRadL(:,:,k) = ( xyr_RadLFlux(:,:,k-1) - xyr_RadLFlux(:,:,k) ) / ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / CpDry * Grav xyz_DTempDtRadS(:,:,k) = ( xyr_RadSFlux(:,:,k-1) - xyr_RadSFlux(:,:,k) ) / ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / CpDry * Grav end do ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine RadiationDTempDt
Subroutine : |
リスタートファイルのクローズと, モジュール内部の変数の割り付け解除を行います.
Close a restart file, and deallocate variables in this module.
subroutine RadiationDennouAGCMFinalize ! ! リスタートファイルのクローズと, ! モジュール内部の変数の割り付け解除を行います. ! ! Close a restart file, and ! deallocate variables in this module. ! ! モジュール引用 ; USE statements ! ! リスタートデータ入出力 ! Restart data input/output ! use gtool_history, only: HistoryClose ! 宣言文 ; Declaration statements ! implicit none ! 実行文 ; Executable statement ! if ( .not. radiation_DennouAGCM_inited ) return ! デフォルト値へ戻す ! Return to default values ! Old_Flux_saved = .false. ! リスタートファイルのクローズ ! close a restart file ! call HistoryClose( history = gthst_rst ) ! (inout) ! 割り付け解除 ! Deallocation ! if ( allocated( xy_IncomRadSFlux ) ) deallocate( xy_IncomRadSFlux ) if ( allocated( xy_InAngle ) ) deallocate( xy_InAngle ) if ( allocated( xy_TempSave ) ) deallocate( xy_TempSave ) if ( allocated( xyr_RadLFluxSave ) ) deallocate( xyr_RadLFluxSave ) if ( allocated( xyr_RadSFluxSave ) ) deallocate( xyr_RadSFluxSave ) if ( allocated( xyra_DelRadLFluxSave ) ) deallocate( xyra_DelRadLFluxSave ) radiation_DennouAGCM_inited = .false. end subroutine RadiationDennouAGCMFinalize
Subroutine : | |||
xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in)
| ||
xyz_QVap(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in)
| ||
xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in)
| ||
xy_SurfAlbedo(0:imax-1, 1:jmax) : | real(DP), intent(in)
| ||
xyr_RadLFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out)
| ||
xyr_RadSFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out)
| ||
xyra_DelRadLFlux(0:imax-1, 1:jmax, 0:kmax, 0:1) : | real(DP), intent(out)
| ||
flag_rst : | logical, intent(in), optional
|
温度, 比湿, 気圧から, 放射フラックスを計算します.
Calculate radiation flux from temperature, specific humidity, and air pressure.
subroutine RadiationDennouAGCMFlux( xyz_Temp, xyz_QVap, xyr_Press, xy_SurfTemp, xy_SurfAlbedo, xyr_RadLFlux, xyr_RadSFlux, xyra_DelRadLFlux, flag_rst ) ! ! 温度, 比湿, 気圧から, 放射フラックスを計算します. ! ! Calculate radiation flux from temperature, specific humidity, and ! air pressure. ! ! モジュール引用 ; USE statements ! ! 短波入射 (太陽入射) ! Short wave (insolation) incoming ! use radiation_short_income, only: ShortIncoming ! use radiation_short_income_sr, only: ShortIncoming ! 物理定数設定 ! Physical constants settings ! use constants, only: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration ! 時刻管理 ! Time control ! use timeset, only: TimeN, EndTime, TimesetClockStart, TimesetClockStop ! リスタートデータ出力 ! Restart data output ! use gtool_history, only: HistoryPut, HistorySetTime ! 日付および時刻の取り扱い ! Date and time handler ! use dc_date, only: operator(-), operator(>=), operator(+), operator(==), toChar, EvalByUnit ! デバッグ用ユーティリティ ! Utilities for debug ! use dc_trace, only: DbgMessage, BeginSub, EndSub, Debug ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in):: xyz_Temp (0:imax-1, 1:jmax, 1:kmax) ! $ T $ . 温度. Temperature real(DP), intent(in):: xyz_QVap (0:imax-1, 1:jmax, 1:kmax) ! $ q $ . 比湿. Specific humidity real(DP), intent(in):: xyr_Press (0:imax-1, 1:jmax, 0:kmax) ! $ \hat{p} $ . 気圧 (半整数レベル). ! Air pressure (half level) real(DP), intent(in):: xy_SurfTemp (0:imax-1, 1:jmax) ! 地表面温度. ! Surface temperature real(DP), intent(in):: xy_SurfAlbedo (0:imax-1, 1:jmax) ! 地表アルベド. ! Surface albedo real(DP), intent(out):: xyr_RadLFlux (0:imax-1, 1:jmax, 0:kmax) ! 長波フラックス. ! Longwave flux real(DP), intent(out):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax) ! 短波 (日射) フラックス. ! Shortwave (insolation) flux real(DP), intent(out):: xyra_DelRadLFlux (0:imax-1, 1:jmax, 0:kmax, 0:1) ! 長波地表温度変化. ! Long wave flux tendency with surface temperature (for save) logical, intent(in), optional:: flag_rst ! リスタートであることを示すフラグ. ! .true. が与えられる場合, ! 長波放射, 短波放射に関するリスタート ! ファイルが必要になります. ! リスタートファイルに関する情報は ! NAMELIST#radiation_DennouAGCM_nml ! で指定されます. ! デフォルトは .false. です. ! ! Flag for restart. ! If .true. is given, ! a restart file for long radiation ! and short radiation is needed. ! Information about the restart file ! is specified by "NAMELIST#radiation_DennouAGCM_nml". ! Default value is .false. ! ! 作業変数 ! Work variables ! real(DP):: xyr_ColDenQVap (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho q \, dz $ . ! 鉛直層 k より上空の水蒸気のカラム密度. ! Column density of water vapor above vertical level k. real(DP):: xyr_ColDenDryAir (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho \, dz $ . ! 鉛直層 k より上空の空気のカラム密度. ! Column density of air above vertical level k. integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction character(STRING):: str_debug ! デバッグ用変数 ! Variable for debug logical:: flag_rst_output ! リスタートファイル出力のフラグ. ! Flag for output of a restart file ! 実行文 ; Executable statement ! ! 計算時間計測開始 ! Start measurement of computation time ! call TimesetClockStart( module_name ) ! 初期化 ! Initialization ! if ( .not. radiation_DennouAGCM_inited ) call RadiationInit( flag_rst ) ! 鉛直層 k より上空のカラム密度の計算 ! Calculate column density above vertical level k ! xyr_ColDenQVap (:,:,kmax) = 0. xyr_ColDenDryAir(:,:,kmax) = 0. do k = kmax-1, 0, -1 xyr_ColDenQVap(:,:,k) = xyr_ColDenQVap(:,:,k+1) + xyz_QVap(:,:,k+1) * ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) ) / Grav xyr_ColDenDryAir(:,:,k) = xyr_ColDenDryAir(:,:,k+1) + ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) ) / Grav end do ! 長波フラックスの算出 ! Calculate long wave flux ! if ( TimeN - PrevTimeLong >= IntTimeLong .or. .not. Old_Flux_saved ) then if ( .not. Old_Flux_saved ) then PrevTimeLong = TimeN else PrevTimeLong = PrevTimeLong + IntTimeLong end if if ( Debug() ) then str_debug = toChar(TimeN) call DbgMessage( '%c: LongFlux is calculated at %c', c1 = module_name, c2 = trim(str_debug) ) end if call LongFlux( xyz_Temp, xy_SurfTemp, xyr_ColDenQVap, xyr_ColDenDryAir, xyr_RadLFlux, xyra_DelRadLFlux ) ! (out) ! 前回の値を利用 ! Use values in last time ! else if ( Debug() ) then str_debug = toChar(TimeN) call DbgMessage( '%c: LongFlux is not calculated at %c. Save values are used.', c1 = module_name, c2 = trim(str_debug) ) end if xyr_RadLFlux = xyr_RadLFluxSave xyra_DelRadLFlux = xyra_DelRadLFluxSave if ( .not. flag_rst_input ) then do k = 0, kmax xyr_RadLFlux(:,:,k) = xyr_RadLFlux(:,:,k) + xyra_DelRadLFlux(:,:,k,1) * ( xyz_Temp(:,:,1) - xy_TempSave ) xyra_DelRadLFlux(:,:,k,1) = xyra_DelRadLFlux(:,:,k,1) / ( xy_TempSave**3 ) * ( xyz_Temp(:,:,1)**3 ) end do else flag_rst_input = .false. call DbgMessage( '%c: restart data is used. ', c1 = module_name ) end if end if ! 短波 (日射) フラックスの算出 ! Calculate short wave (insolation) ! if ( TimeN - PrevTimeShort >= IntTimeShort .or. .not. Old_Flux_saved ) then if ( .not. Old_Flux_saved ) then PrevTimeShort = TimeN else PrevTimeShort = PrevTimeShort + IntTimeShort end if if ( Debug() ) then str_debug = toChar(TimeN) call DbgMessage( '%c: ShortFlux is calculated at %c', c1 = module_name, c2 = trim(str_debug) ) end if ! 短波入射の計算 ! Calculate short wave (insolation) incoming radiation ! call ShortIncoming( xy_IncomRadSFlux, xy_InAngle ) ! (out) ! 大気アルベドの考慮 ! Taking atmospheric albedo into consideration ! xy_IncomRadSFlux = xy_IncomRadSFlux * ( 1.0d0 - ShortAtmosAlbedo ) ! 短波フラックスの計算 ! Calculate short wave (insolation) flux ! xyr_RadSFlux(:,:,0:kmax-1) = 0. xyr_RadSFlux(:,:, kmax ) = xy_IncomRadSFlux call ShortFlux( xyr_ColDenQVap, xyr_ColDenDryAir, xy_SurfAlbedo, xyr_RadSFlux ) ! (inout) ! 前回の値を利用 ! Use values in last time ! else if ( Debug() ) then str_debug = toChar(TimeN) call DbgMessage( '%c: ShortFlux is not calculated at %c. Save values are used.', c1 = module_name, c2 = trim(str_debug) ) end if xyr_RadSFlux = xyr_RadSFluxSave end if ! 今回計算した値を保存 ! Save calculated values in this time ! xy_TempSave = xyz_Temp (:,:,1) xyr_RadLFluxSave = xyr_RadLFlux xyr_RadSFluxSave = xyr_RadSFlux xyra_DelRadLFluxSave = xyra_DelRadLFlux if ( .not. Old_Flux_saved ) Old_Flux_saved = .true. ! リスタートファイルの出力タイミングのチェック ! Check output timing of a restart file ! flag_rst_output = TimeN - PrevRstOutputTime >= RstFileIntTime if ( TimeN >= EndTime .and. .not. flag_rst_output_end ) then flag_rst_output = .true. flag_rst_output_end = .true. end if flag_rst_output = ( .not. TimeN == PrevRstOutputTime ) .and. flag_rst_output if ( flag_rst_output ) then ! 次回用に, 今回の出力 (希望) 時刻 を保存 ! Save output time (expected) in this time, for next time ! PrevRstOutputTime = PrevRstOutputTime + RstFileIntTime ! 時刻の設定 ! Set time ! call HistorySetTime( difftime = TimeN, history = gthst_rst ) ! データ出力 ! Data output ! call HistoryPut( 'PrevTimeLong', EvalByUnit(PrevTimeLong, DelTimeLongUnit), history = gthst_rst ) ! (in) call HistoryPut( 'PrevTimeShort', EvalByUnit(PrevTimeShort, DelTimeShortUnit), history = gthst_rst ) ! (in) call HistoryPut( 'SurfTemp', xy_TempSave, history = gthst_rst ) ! (in) call HistoryPut( 'RadLFlux', xyr_RadLFluxSave, history = gthst_rst ) ! (in) call HistoryPut( 'RadSFlux', xyr_RadSFluxSave, history = gthst_rst ) ! (in) call HistoryPut( 'DelRadLFlux', xyra_DelRadLFluxSave, history = gthst_rst ) ! (in) end if ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine RadiationDennouAGCMFlux
Subroutine : | |||
xyr_RadSFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_RadLFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyra_DelRadLFlux(0:imax-1, 1:jmax, 0:kmax, 0:1) : | real(DP), intent(in)
| ||
xy_DSurfTempDt(0:imax-1, 1:jmax) : | real(DP), intent(in)
|
放射フラックス (xyr_RadSFlux, xyr_RadLFlux) について, その他の引数を用いて補正し, 出力を行う.
Radiation fluxes (xyr_RadSFlux, xyr_RadLFlux) are corrected by using other arguments, and the corrected values are output.
subroutine RadiationFluxOutput( xyr_RadSFlux, xyr_RadLFlux, xyra_DelRadLFlux, xy_DSurfTempDt ) ! ! 放射フラックス (xyr_RadSFlux, xyr_RadLFlux) ! について, その他の引数を用いて補正し, 出力を行う. ! ! Radiation fluxes (xyr_RadSFlux, xyr_RadLFlux) are ! corrected by using other arguments, and the corrected values are output. ! ! モジュール引用 ; USE statements ! ! 時刻管理 ! Time control ! use timeset, only: DelTime, TimeN, TimesetClockStart, TimesetClockStop ! ヒストリデータ出力 ! History data output ! use gtool_historyauto, only: HistoryAutoPut ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax) ! 短波 (日射) フラックス. ! Shortwave (insolation) flux real(DP), intent(in):: xyr_RadLFlux (0:imax-1, 1:jmax, 0:kmax) ! 長波フラックス. ! Longwave flux real(DP), intent(in):: xyra_DelRadLFlux (0:imax-1, 1:jmax, 0:kmax, 0:1) ! 長波地表温度変化. ! Surface temperature tendency with longwave real(DP), intent(in):: xy_DSurfTempDt (0:imax-1, 1:jmax) ! 地表面温度変化率. ! Surface temperature tendency ! 出力のための作業変数 ! Work variables for output ! real(DP):: xyr_RadLFluxCor (0:imax-1, 1:jmax, 0:kmax) ! 補正された長波フラックス. ! Corrected longwave flux ! 作業変数 ! Work variables ! integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction ! 実行文 ; Executable statement ! ! 計算時間計測開始 ! Start measurement of computation time ! call TimesetClockStart( module_name ) ! 初期化 ! Initialization ! if ( .not. radiation_DennouAGCM_inited ) call RadiationInit ! 長波フラックスの補正 ( 地表フラックス分の補正 ) ! Correct longwave flux ( amount of surface flux ) ! do k = 0, kmax xyr_RadLFluxCor (:,:,k) = xyr_RadLFlux (:,:,k) + xyra_DelRadLFlux(:,:,k,0) * xy_DSurfTempDt (:,:) * DelTime end do ! ヒストリデータ出力 ! History data output ! call HistoryAutoPut( TimeN, 'OLR' , xyr_RadLFluxCor(:,:,kmax) ) call HistoryAutoPut( TimeN, 'SLR' , xyr_RadLFluxCor(:,:,0) ) call HistoryAutoPut( TimeN, 'OSR' , xyr_RadSFlux (:,:,kmax) ) call HistoryAutoPut( TimeN, 'SSR' , xyr_RadSFlux (:,:,0) ) ! ヒストリデータ出力 ! History data output ! call HistoryAutoPut( TimeN, 'OLRB', xyr_RadLFlux (:,:,kmax) ) call HistoryAutoPut( TimeN, 'SLRB', xyr_RadLFlux (:,:,0) ) call HistoryAutoPut( TimeN, 'OSRB', xyr_RadSFlux (:,:,kmax) ) call HistoryAutoPut( TimeN, 'SSRB', xyr_RadSFlux (:,:,0) ) ! 長波フラックスの補正 ( 地表フラックス分の補正 ) ! Correct longwave flux ( amount of surface flux ) ! do k = 0, kmax xyr_RadLFluxCor (:,:,k) = xyr_RadLFlux (:,:,k) + xyra_DelRadLFlux(:,:,k,0) * xy_DSurfTempDt (:,:) * 2.0d0 * DelTime end do ! ヒストリデータ出力 ! History data output ! call HistoryAutoPut( TimeN, 'OLRA', xyr_RadLFluxCor(:,:,kmax) ) call HistoryAutoPut( TimeN, 'SLRA', xyr_RadLFluxCor(:,:,0) ) call HistoryAutoPut( TimeN, 'OSRA', xyr_RadSFlux (:,:,kmax) ) call HistoryAutoPut( TimeN, 'SSRA', xyr_RadSFlux (:,:,0) ) ! 計算時間計測一時停止 ! Pause measurement of computation time ! call TimesetClockStop( module_name ) end subroutine RadiationFluxOutput
Variable : | |||
radiation_DennouAGCM_inited = .false. : | logical, save, public
|
Variable : | |||
DelTimeLongUnit : | character(STRING), save
|
Variable : | |||
DelTimeLongValue : | real(DP), save
|
Variable : | |||
DelTimeShortUnit : | character(STRING), save
|
Variable : | |||
DelTimeShortValue : | real(DP), save
|
Subroutine : |
依存モジュールの初期化チェック
Check initialization of dependency modules
subroutine InitCheck ! ! 依存モジュールの初期化チェック ! ! Check initialization of dependency modules ! モジュール引用 ; USE statements ! ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_util_inited ! 格子点設定 ! Grid points settings ! use gridset, only: gridset_inited ! 物理定数設定 ! Physical constants settings ! use constants, only: constants_inited ! 座標データ設定 ! Axes data settings ! use axesset, only: axesset_inited ! 時刻管理 ! Time control ! use timeset, only: timeset_inited ! リスタートデータ入出力 ! Restart data input/output ! use restart_file_io, only: restart_file_io_inited ! 実行文 ; Executable statement ! if ( .not. namelist_util_inited ) call MessageNotify( 'E', module_name, '"namelist_util" module is not initialized.' ) if ( .not. gridset_inited ) call MessageNotify( 'E', module_name, '"gridset" module is not initialized.' ) if ( .not. constants_inited ) call MessageNotify( 'E', module_name, '"constants" module is not initialized.' ) if ( .not. axesset_inited ) call MessageNotify( 'E', module_name, '"axesset" module is not initialized.' ) if ( .not. timeset_inited ) call MessageNotify( 'E', module_name, '"timeset" module is not initialized.' ) if ( .not. restart_file_io_inited ) call MessageNotify( 'E', module_name, '"restart_file_io" module is not initialized.' ) end subroutine InitCheck
Variable : | |||
IntTimeLong : | type(DC_DIFFTIME), save
|
Variable : | |||
IntTimeShort : | type(DC_DIFFTIME), save
|
Variable : | |||
LongAbsorpCoefDryAir(1:MaxNmlArySize) : | real(DP), save
|
Variable : | |||
LongAbsorpCoefQVap(1:MaxNmlArySize) : | real(DP), save
|
Subroutine : | |||
xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in)
| ||
xy_SurfTemp(0:imax-1, 1:jmax) : | real(DP), intent(in)
| ||
xyr_ColDenQVap(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_ColDenDryAir(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_RadLFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out)
| ||
xyra_DelRadLFlux(0:imax-1, 1:jmax, 0:kmax, 0:1) : | real(DP), intent(out)
|
長波フラックスの計算
Calculate long wave flux
subroutine LongFlux( xyz_Temp, xy_SurfTemp, xyr_ColDenQVap, xyr_ColDenDryAir, xyr_RadLFlux, xyra_DelRadLFlux ) ! ! 長波フラックスの計算 ! ! Calculate long wave flux ! ! モジュール引用 ; USE statements ! ! 物理定数設定 ! Physical constants settings ! use constants, only: StB ! $ \sigma_{SB} $ . ! ステファンボルツマン定数. ! Stefan-Boltzmann constant ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in):: xyz_Temp (0:imax-1, 1:jmax, 1:kmax) ! $ T $ . 温度. Temperature real(DP), intent(in):: xy_SurfTemp (0:imax-1, 1:jmax) ! 地表面温度. ! Surface temperature real(DP), intent(in):: xyr_ColDenQVap (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho q \, dz $ . ! 鉛直層 k より上空の水蒸気のカラム密度. ! Column density of water vapor above vertical level k. real(DP), intent(in):: xyr_ColDenDryAir (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho \, dz $ . ! 鉛直層 k より上空の空気のカラム密度. ! Column density of air above vertical level k. real(DP), intent(out):: xyr_RadLFlux (0:imax-1, 1:jmax, 0:kmax) ! 長波フラックス. ! Longwave flux real(DP), intent(out):: xyra_DelRadLFlux (0:imax-1, 1:jmax, 0:kmax, 0:1) ! 長波地表温度変化. ! Surface temperature tendency with longwave ! 作業変数 ! Work variables ! real(DP):: xyr_Trans (0:imax-1, 1:jmax, 0:kmax) ! 透過係数. ! Transmission coefficient real(DP):: xyr_Trans1 (0:imax-1, 1:jmax, 0:kmax) ! 1/2 レベルからの透過係数. ! Transmission coefficient above 1/2 level real(DP):: xyr_Trans2 (0:imax-1, 1:jmax, 0:kmax) ! 3/2 レベルからの透過係数. ! Transmission coefficient above 3/2 level real(DP):: xyz_PiB (0:imax-1, 1:jmax, 1:kmax) ! $ \pi B = \sigma T^{4} $ real(DP):: xy_SurfPiB (0:imax-1, 1:jmax) ! 地表面の $ \pi B $ . ! $ \pi B $ on surface real(DP):: BandWeightSum ! バンドウェイトの和 ! Sum of band weights integer:: k, kk ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: bn ! 波長について回る DO ループ用作業変数 ! Work variables for DO loop in wavenumber bands ! 実行文 ; Executable statement ! ! バンドウェイトの設定 ! Configure band weight ! BandWeightSum = 0. do bn = 1, LongBandNum BandWeightSum = BandWeightSum + LongBandWeight(bn) end do do bn = 1, LongBandNum LongBandWeight(bn) = LongBandWeight(bn) / BandWeightSum end do ! $ \pi B $ の計算 ! Calculate $ \pi B $ ! xyz_PiB = StB * ( xyz_Temp**4 ) xy_SurfPiB = StB * ( xy_SurfTemp**4 ) do k = 0, kmax ! 透過関数計算 ! Calculate transmission functions ! xyr_Trans = 0. do bn = 1, LongBandNum do kk = 0, kmax xyr_Trans(:,:,kk) = xyr_Trans(:,:,kk) + LongBandWeight(bn) * exp( - LongPathLengthFact * ( LongAbsorpCoefQVap(bn) * abs( xyr_ColDenQVap(:,:,kk) - xyr_ColDenQVap(:,:,k) ) + LongAbsorpCoefDryAir(bn) * abs( xyr_ColDenDryAir(:,:,kk) - xyr_ColDenDryAir(:,:,k) ) ) ) end do end do ! 放射フラックス計算 ! Calculate radiation flux ! xyr_RadLFlux(:,:,k) = xy_SurfPiB * xyr_Trans(:,:,0) do kk = 0, kmax-1 xyr_RadLFlux(:,:,k) = xyr_RadLFlux(:,:,k) - xyz_PiB(:,:,kk+1) * ( xyr_Trans(:,:,kk) - xyr_Trans(:,:,kk+1) ) end do ! 補正項計算用透過関数計算 ! Calculate transmission functions for correction terms ! xyr_Trans1(:,:,k) = xyr_Trans(:,:,0) xyr_Trans2(:,:,k) = xyr_Trans(:,:,1) end do ! 長波地表温度変化の計算 ! Calclate surface temperature tendency with long wave ! do k = 0, kmax xyra_DelRadLFlux(:,:,k,0) = 4.0_DP * xy_SurfPiB / xy_SurfTemp * xyr_Trans1(:,:,k) xyra_DelRadLFlux(:,:,k,1) = 4.0_DP * xyz_PiB(:,:,1) / xyz_Temp(:,:,1) * ( xyr_Trans2(:,:,k) - xyr_Trans1(:,:,k) ) end do end subroutine LongFlux
Variable : | |||
LongPathLengthFact : | real(DP), save
|
Variable : | |||
Old_Flux_saved = .false. : | logical, save
|
Variable : | |||
PrevRstOutputTime : | type(DC_DIFFTIME), save
|
Variable : | |||
PrevTimeLong : | type(DC_DIFFTIME), save
|
Variable : | |||
PrevTimeShort : | type(DC_DIFFTIME), save
|
Subroutine : | |||
flag_rst : | logical, intent(in), optional
|
radiation_DennouAGCM モジュールの初期化を行います. NAMELIST#radiation_DennouAGCM_nml の読み込みはこの手続きで行われます.
"radiation_DennouAGCM" module is initialized. "NAMELIST#radiation_DennouAGCM_nml" is loaded in this procedure.
This procedure input/output NAMELIST#radiation_DennouAGCM_nml .
subroutine RadiationInit( flag_rst ) ! ! radiation_DennouAGCM モジュールの初期化を行います. ! NAMELIST#radiation_DennouAGCM_nml の読み込みはこの手続きで行われます. ! ! "radiation_DennouAGCM" module is initialized. ! "NAMELIST#radiation_DennouAGCM_nml" is loaded in this procedure. ! ! モジュール引用 ; USE statements ! ! 出力ファイルの基本情報 ! Basic information for output files ! use fileset, only: FileTitle, FileSource, FileInstitution ! データファイルを最終的に変更した組織/個人. ! Institution or person that changes data files for the last time ! 物理定数設定 ! Physical constants settings ! use constants, only: PI ! $ \pi $ . ! 円周率. Circular constant ! 座標データ設定 ! Axes data settings ! use axesset, only: x_Lon, x_Lon_Weight, y_Lat, y_Lat_Weight, z_Sigma, r_Sigma, z_DelSigma ! $ \Delta \sigma $ (整数). ! $ \Delta \sigma $ (Full) ! 時刻管理 ! Time control ! use timeset, only: StartTime ! 計算開始時刻. ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid ! 日付および時刻の取り扱い ! Date and time handler ! use dc_date, only: DCDiffTimeCreate, EvalByUnit ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! 種別型パラメタ ! Kind type parameter ! use dc_types, only: STDOUT ! 標準出力の装置番号. Unit number of standard output ! 組み込み関数 PRESENT の拡張版関数 ! Extended functions of intrinsic function "PRESENT" ! use dc_present, only: present_and_true ! ヒストリデータ出力 ! History data output ! use gtool_historyauto, only: HistoryAutoAddVariable ! リスタートデータ入出力 ! Restart data input/output ! use gtool_history, only: HistoryCreate, HistoryAddAttr, HistoryAddVariable, HistoryPut, HistoryGet, HistoryGetAttr ! 文字列操作 ! Character handling ! use dc_string, only: toChar ! 宣言文 ; Declaration statements ! implicit none logical, intent(in), optional:: flag_rst ! リスタートであることを示すフラグ. ! .true. が与えられる場合, ! 長波放射, 短波放射に関するリスタート ! ファイルが必要になります. ! リスタートファイルに関する情報は ! NAMELIST#radiation_DennouAGCM_nml ! で指定されます. ! デフォルトは .false. です. ! ! Flag for restart. ! If .true. is given, ! a restart file for long radiation ! and short radiation is needed. ! Information about the restart file ! is specified by "NAMELIST#radiation_DennouAGCM_nml". ! Default value is .false. ! character(STRING):: RstInputFile ! 入力するリスタートデータのファイル名 ! Filename of input restart data character(STRING):: RstOutputFile ! 出力するリスタートデータのファイル名 ! Filename of output restart data character(STRING):: time_range ! 時刻の指定. ! Specification of time real(DP):: PrevTimeLongValue ! 前回長波フラックスを計算した時刻 (数値) ! Time (numerical value) when long wave flux is calculated character(STRING):: PrevTimeLongUnit ! 前回長波フラックスを計算した時刻 (単位) ! Time (unit) when long wave flux is calculated real(DP):: PrevTimeShortValue ! 前回長波フラックスを計算した時刻 (数値) ! Time (numerical value) when long wave flux is calculated character(STRING):: PrevTimeShortUnit ! 前回長波フラックスを計算した時刻 (単位) ! Time (unit) when long wave flux is calculated character(TOKEN):: dummy_str ! 入力チェック用のダミー変数 ! Dummy variable for check of input logical:: get_err ! 入力時のエラーフラグ. ! Error flag for input integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read character(STRING):: title_msg ! 表題に付加するメッセージ. ! Message added to title real:: origin_time ! 計算開始時刻. ! Start time of calculation character(12):: time_unit ! 日時の単位. Units of date and time logical:: flag_mpi_init #ifdef LIB_MPI integer:: err_mpi #endif ! NAMELIST 変数群 ! NAMELIST group name ! namelist /radiation_DennouAGCM_nml/ DelTimeLongValue, DelTimeLongUnit, DelTimeShortValue, DelTimeShortUnit, LongBandNum, LongAbsorpCoefQVap, LongAbsorpCoefDryAir, LongBandWeight, LongPathLengthFact, ShortBandNum, ShortAbsorpCoefQVap, ShortAbsorpCoefDryAir, ShortBandWeight, ShortSecScat, ShortAtmosAlbedo, RstInputFile, RstOutputFile ! ! デフォルト値については初期化手続 "radiation_DennouAGCM#RadiationInit" ! のソースコードを参照のこと. ! ! Refer to source codes in the initialization procedure ! "radiation_DennouAGCM#RadiationInit" for the default values. ! ! 実行文 ; Executable statement ! if ( radiation_DennouAGCM_inited ) return call InitCheck #ifdef LIB_MPI ! MPI における初期化が行われているかを確認する. ! Confirm initialization of MPI ! call MPI_Initialized(flag_mpi_init, err_mpi) #else flag_mpi_init = .false. #endif ! デフォルト値の設定 ! Default values settings ! ! 長波フラックス用情報 ! Information for long wave flux ! PrevTimeLong = StartTime DelTimeLongValue = 3.0_DP DelTimeLongUnit = 'hrs.' LongBandNum = 4 LongAbsorpCoefQVap = -999.9_DP LongAbsorpCoefDryAir = -999.9_DP LongBandWeight = -999.9_DP LongAbsorpCoefQVap (1:LongBandNum) = (/ 8.0_DP, 1.0_DP, 0.1_DP, 0.0_DP /) LongAbsorpCoefDryAir (1:LongBandNum) = (/ 0.0_DP, 0.0_DP, 0.0_DP, 5.0e-5_DP /) LongBandWeight (1:LongBandNum) = (/ 0.2_DP, 0.1_DP, 0.1_DP, 0.6_DP /) LongPathLengthFact = 1.5_DP ! 短波フラックス用情報 ! Information for short wave flux ! PrevTimeShort = StartTime DelTimeShortValue = 1.0_DP DelTimeShortUnit = 'hrs.' ShortBandNum = 1 ShortAbsorpCoefQVap = -999.9_DP ShortAbsorpCoefDryAir = -999.9_DP ShortBandWeight = -999.9_DP ShortAbsorpCoefQVap (1:ShortBandNum) = (/ 0.002_DP /) ShortAbsorpCoefDryAir (1:ShortBandNum) = (/ 0.0_DP /) ShortBandWeight (1:ShortBandNum) = (/ 1.0_DP /) ShortSecScat = 1.66_DP ShortAtmosAlbedo = 0.2_DP ! リスタートファイル情報 ! Information about a restart file ! RstInputFile = '' RstOutputFile = 'rst_rad.nc' ! 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 = radiation_DennouAGCM_nml, iostat = iostat_nml ) ! (out) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) end if ! 時間間隔の処理 ! Handle interval time ! call DCDiffTimeCreate( IntTimeLong, DelTimeLongValue, DelTimeLongUnit ) ! (in) call DCDiffTimeCreate( IntTimeShort, DelTimeShortValue, DelTimeShortUnit ) ! (in) ! バンド数, 吸収係数, バンドウェイトのチェック ! Check number of band, absorption coefficients, band weight ! call NmlutilAryValid( module_name, LongAbsorpCoefQVap, 'LongAbsorpCoefQVap', LongBandNum, 'LongBandNum' ) ! (in) call NmlutilAryValid( module_name, LongAbsorpCoefDryAir, 'LongAbsorpCoefDryAir', LongBandNum, 'LongBandNum' ) ! (in) call NmlutilAryValid( module_name, LongBandWeight, 'LongBandWeight', LongBandNum, 'LongBandNum' ) ! (in) call NmlutilAryValid( module_name, ShortAbsorpCoefQVap, 'ShortAbsorpCoefQVap', ShortBandNum, 'ShortBandNum' ) ! (in) call NmlutilAryValid( module_name, ShortAbsorpCoefDryAir, 'ShortAbsorpCoefDryAir', ShortBandNum, 'ShortBandNum' ) ! (in) call NmlutilAryValid( module_name, ShortBandWeight, 'ShortBandWeight', ShortBandNum, 'ShortBandNum' ) ! (in) ! ヒストリデータ出力のためのへの変数登録 ! Register of variables for history data output ! call HistoryAutoAddVariable( 'OLR', (/ 'lon ', 'lat ', 'time' /), 'outgoing longwave', 'W m-2' ) call HistoryAutoAddVariable( 'SLR', (/ 'lon ', 'lat ', 'time' /), 'surface longwave', 'W m-2' ) call HistoryAutoAddVariable( 'OSR', (/ 'lon ', 'lat ', 'time' /), 'outgoing shortwave', 'W m-2' ) call HistoryAutoAddVariable( 'SSR', (/ 'lon ', 'lat ', 'time' /), 'surface shortwave', 'W m-2' ) call HistoryAutoAddVariable( 'OLRB', (/ 'lon ', 'lat ', 'time' /), 'outgoing longwave', 'W m-2' ) call HistoryAutoAddVariable( 'SLRB', (/ 'lon ', 'lat ', 'time' /), 'surface longwave', 'W m-2' ) call HistoryAutoAddVariable( 'OSRB', (/ 'lon ', 'lat ', 'time' /), 'outgoing shortwave', 'W m-2' ) call HistoryAutoAddVariable( 'SSRB', (/ 'lon ', 'lat ', 'time' /), 'surface shortwave', 'W m-2' ) call HistoryAutoAddVariable( 'OLRA', (/ 'lon ', 'lat ', 'time' /), 'outgoing longwave', 'W m-2' ) call HistoryAutoAddVariable( 'SLRA', (/ 'lon ', 'lat ', 'time' /), 'surface longwave', 'W m-2' ) call HistoryAutoAddVariable( 'OSRA', (/ 'lon ', 'lat ', 'time' /), 'outgoing shortwave', 'W m-2' ) call HistoryAutoAddVariable( 'SSRA', (/ 'lon ', 'lat ', 'time' /), 'surface shortwave', 'W m-2' ) ! 短波入射用変数の割付 ! Allocate variables for short wave (insolation) incoming radiation ! allocate( xy_IncomRadSFlux (0:imax-1, 1:jmax) ) allocate( xy_InAngle (0:imax-1, 1:jmax) ) ! 保存用の変数の割り付け ! Allocate variables for saving ! allocate( xy_TempSave (0:imax-1, 1:jmax) ) allocate( xyr_RadLFluxSave (0:imax-1, 1:jmax, 0:kmax) ) allocate( xyr_RadSFluxSave (0:imax-1, 1:jmax, 0:kmax) ) allocate( xyra_DelRadLFluxSave (0:imax-1, 1:jmax, 0:kmax, 0:1) ) ! リスタートファイルの入力 ! Input restart file ! if ( present_and_true( flag_rst ) ) then if ( trim(RstInputFile) == '' ) then call MessageNotify( 'E', module_name, 'a restart file is needed. ' // 'Specify the restart file to "RstInputFile" in NAMELIST "radiation_DennouAGCM_nml"' ) end if ! 時刻情報の取得 ! Get time information ! time_range = 'time=' // toChar( EvalbyUnit( StartTime, RstFileIntUnit ) ) ! ファイルの有無を確認 ! Conform an existence of an input file ! call HistoryGetAttr( RstInputFile, 'lon', 'units', dummy_str, flag_mpi_split = flag_mpi_init, err = get_err ) ! (out) if ( get_err ) then call MessageNotify( 'E', module_name, 'restart/initial data file "%c" is not found.', c1 = trim(RstInputFile) ) end if ! 入力 ! Input ! call HistoryGet( RstInputFile, 'SurfTemp', xy_TempSave, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGet( RstInputFile, 'RadLFlux', xyr_RadLFluxSave, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGet( RstInputFile, 'RadSFlux', xyr_RadSFluxSave, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGet( RstInputFile, 'DelRadLFlux', xyra_DelRadLFluxSave, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGet( RstInputFile, 'PrevTimeLong', PrevTimeLongValue, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGetAttr( RstInputFile, 'PrevTimeLong', 'units', PrevTimeLongUnit, flag_mpi_split = flag_mpi_init ) ! (in) optional call DCDiffTimeCreate( PrevTimeLong, PrevTimeLongValue, PrevTimeLongUnit ) ! (in) if ( trim(PrevTimeLongUnit) /= trim(DelTimeLongUnit) ) then call MessageNotify( 'E', module_name, 'unit of PrevTimeLong <%c> in "%c" is differ from DelTimeLongUnit=<%c>', c1 = trim(PrevTimeLongUnit), c2 = trim(RstInputFile), c3 = trim(DelTimeLongUnit) ) end if call HistoryGet( RstInputFile, 'PrevTimeShort', PrevTimeShortValue, range = time_range, flag_mpi_split = flag_mpi_init ) ! (in) optional call HistoryGetAttr( RstInputFile, 'PrevTimeShort', 'units', PrevTimeShortUnit, flag_mpi_split = flag_mpi_init ) ! (in) optional call DCDiffTimeCreate( PrevTimeShort, PrevTimeShortValue, PrevTimeShortUnit ) ! (in) if ( trim(PrevTimeShortUnit) /= trim(DelTimeShortUnit) ) then call MessageNotify( 'E', module_name, 'unit of PrevTimeShort <%c> in "%c" is differ from DelTimeShortUnit=<%c>', c1 = trim(PrevTimeShortUnit), c2 = trim(RstInputFile), c3 = trim(DelTimeShortUnit) ) end if flag_rst_input = .true. Old_Flux_saved = .true. else RstInputFile = '' PrevTimeLongUnit = DelTimeLongUnit PrevTimeShortUnit = DelTimeShortUnit flag_rst_input = .false. Old_Flux_saved = .false. end if ! 出力時間間隔の設定 ! Configure time interval of output ! PrevRstOutputTime = StartTime ! リスタートファイルの作成 ! Create a restart file ! title_msg = ' restart data for "' // module_name // '" module' origin_time = EvalByUnit( StartTime, RstFileIntUnit ) time_unit = RstFileIntUnit call HistoryCreate( file = RstOutputFile, title = trim(FileTitle) // trim(title_msg), source = FileSource, institution = FileInstitution, dims = (/ 'lon ', 'lat ', 'sig ', 'sigm ', 'sorbl', 'time ' /), dimsizes = (/ imax, jmax, kmax, kmax + 1, 2, 0 /), longnames = (/ 'longitude ', 'latitude ', 'sigma at layer midpoints ', 'sigma at layer end-points (half level)', 'surface or bottom layer ', 'time ' /), units = (/ 'degree_east ', 'degree_north', '1 ', '1 ', '1 ', time_unit /), xtypes = (/'double', 'double', 'double', 'double', 'int ', 'double'/), origin = origin_time, interval = RstFileIntValue, flag_mpi_split = flag_mpi_init, history = gthst_rst ) ! (out) optional ! 座標データの設定 ! Axes data settings ! call HistoryAddAttr( 'lon', attrname = 'standard_name', value = 'longitude', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'lat', attrname = 'standard_name', value = 'latitude', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'sig', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'sigm', attrname = 'standard_name', value = 'atmosphere_sigma_coordinate', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'time', attrname = 'standard_name', value = 'time', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'sig', attrname = 'positive', value = 'down', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'sigm', attrname = 'positive', value = 'down', history = gthst_rst ) ! (inout) call HistoryPut( 'lon', x_Lon / PI * 180.0_DP, history = gthst_rst ) ! (inout) call HistoryPut( 'lat', y_Lat / PI * 180.0_DP, history = gthst_rst ) ! (inout) call HistoryPut( 'sig', z_Sigma, history = gthst_rst ) ! (inout) call HistoryPut( 'sigm', r_Sigma, history = gthst_rst ) ! (inout) call HistoryPut( 'sorbl', (/ 0, 1 /), history = gthst_rst ) ! (inout) ! 座標重みの設定 ! Axes weights settings ! call HistoryAddVariable( 'lon_weight', (/'lon'/), 'weight for integration in longitude', 'radian', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'lon', attrname = 'gt_calc_weight', value = 'lon_weight', history = gthst_rst ) ! (inout) call HistoryPut( 'lon_weight', x_Lon_Weight, history = gthst_rst ) ! (inout) call HistoryAddVariable( 'lat_weight', (/'lat'/), 'weight for integration in latitude', units = 'radian', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'lat', attrname = 'gt_calc_weight', value = 'lat_weight', history = gthst_rst ) ! (inout) call HistoryPut( 'lat_weight', y_Lat_Weight, history = gthst_rst ) ! (inout) call HistoryAddVariable( 'sig_weight', (/'sig'/), 'weight for integration in sigma', '1', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddAttr( 'sig', attrname = 'gt_calc_weight', value = 'sig_weight', history = gthst_rst ) ! (inout) call HistoryPut( 'sig_weight', z_DelSigma, history = gthst_rst ) ! (inout) call HistoryAddVariable( 'PrevTimeLong', (/ 'time' /), 'previous time at which longwave flux is calculated', PrevTimeLongUnit, xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddVariable( 'PrevTimeShort', (/ 'time' /), 'previous time at which shortwave flux is calculated', PrevTimeShortUnit, xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddVariable( 'SurfTemp', (/ 'lon ', 'lat ', 'time' /), 'surface temperature', 'K', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddVariable( 'RadLFlux', (/ 'lon ', 'lat ', 'sigm', 'time' /), 'longwave flux', 'W m-2', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddVariable( 'RadSFlux', (/ 'lon ', 'lat ', 'sigm', 'time' /), 'shortwave flux', 'W m-2', xtype = 'double', history = gthst_rst ) ! (inout) call HistoryAddVariable( 'DelRadLFlux', (/ 'lon ', 'lat ', 'sigm ', 'sorbl', 'time ' /), 'longwave flux tendency with surface temperature', 'W m-2 K-1', xtype = 'double', history = gthst_rst ) ! (inout) ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, 'Restart:' ) if ( trim(RstInputFile) == '' ) then call MessageNotify( 'M', module_name, ' InputFile = <no input>', c1 = trim( RstInputFile ) ) else call MessageNotify( 'M', module_name, ' InputFile = %c', c1 = trim( RstInputFile ) ) call MessageNotify( 'M', module_name, ' PrevTimeLong = %f [%c]', d = (/ PrevTimeLongValue /), c1 = trim( PrevTimeLongUnit ) ) call MessageNotify( 'M', module_name, ' PrevTimeShort = %f [%c]', d = (/ PrevTimeShortValue /), c1 = trim( PrevTimeShortUnit ) ) end if call MessageNotify( 'M', module_name, ' OutputFile = %c', c1 = trim( RstOutputFile ) ) call MessageNotify( 'M', module_name, ' IntTime = %r [%c] (same as IntTime in "restart_file_io" module)', r = (/ RstFileIntValue /), c1 = trim( RstFileIntUnit ) ) ! call MessageNotify( 'M', module_name, 'DelTime:' ) call MessageNotify( 'M', module_name, ' DelTimeLong = %f [%c]', d = (/ DelTimeLongValue /), c1 = trim( DelTimeLongUnit ) ) call MessageNotify( 'M', module_name, ' DelTimeShort = %f [%c]', d = (/ DelTimeShortValue /), c1 = trim( DelTimeShortUnit ) ) ! call MessageNotify( 'M', module_name, 'LongFlux:' ) call MessageNotify( 'M', module_name, ' LongBandNum = %d', i = (/ LongBandNum /) ) call MessageNotify( 'M', module_name, ' LongAbsorpCoefQVap = (/ %*r /)', r = real( LongAbsorpCoefQVap(1:LongBandNum) ), n = (/ LongBandNum /) ) call MessageNotify( 'M', module_name, ' LongAbsorpCoefDryAir = (/ %*r /)', r = real( LongAbsorpCoefDryAir(1:LongBandNum) ), n = (/ LongBandNum /) ) call MessageNotify( 'M', module_name, ' LongBandWeight = (/ %*r /)', r = real( LongBandWeight(1:LongBandNum) ), n = (/ LongBandNum /) ) call MessageNotify( 'M', module_name, ' LongPathLengthFact = %f', d = (/ LongPathLengthFact /) ) ! call MessageNotify( 'M', module_name, 'ShortFlux:' ) call MessageNotify( 'M', module_name, ' ShortBandNum = %d', i = (/ ShortBandNum /) ) call MessageNotify( 'M', module_name, ' ShortAbsorpCoefQVap = (/ %*r /)', r = real( ShortAbsorpCoefQVap(1:ShortBandNum) ), n = (/ ShortBandNum /) ) call MessageNotify( 'M', module_name, ' ShortAbsorpCoefDryAir = (/ %*r /)', r = real( ShortAbsorpCoefDryAir(1:ShortBandNum) ), n = (/ ShortBandNum /) ) call MessageNotify( 'M', module_name, ' ShortBandWeight = (/ %*r /)', r = real( ShortBandWeight(1:ShortBandNum) ), n = (/ ShortBandNum /) ) call MessageNotify( 'M', module_name, ' ShortSecScat = %f', d = (/ ShortSecScat /) ) call MessageNotify( 'M', module_name, ' ShortAtmosAlbedo = %f', d = (/ ShortAtmosAlbedo /) ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) radiation_DennouAGCM_inited = .true. end subroutine RadiationInit
Variable : | |||
ShortAbsorpCoefDryAir(1:MaxNmlArySize) : | real(DP), save
|
Variable : | |||
ShortAbsorpCoefQVap(1:MaxNmlArySize) : | real(DP), save
|
Subroutine : | |||
xyr_ColDenQVap(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xyr_ColDenDryAir(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in)
| ||
xy_SurfAlbedo(0:imax-1, 1:jmax) : | real(DP), intent(in)
| ||
xyr_RadSFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(inout)
|
短波フラックスを計算します.
Calculate short wave flux.
subroutine ShortFlux( xyr_ColDenQVap, xyr_ColDenDryAir, xy_SurfAlbedo, xyr_RadSFlux ) ! ! 短波フラックスを計算します. ! ! Calculate short wave flux. ! ! モジュール引用 ; USE statements ! ! 宣言文 ; Declaration statements ! implicit none real(DP), intent(in):: xyr_ColDenQVap (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho q \, dz $ . ! 鉛直層 k より上空の水蒸気のカラム密度. ! Column density of water vapor above vertical level k. real(DP), intent(in):: xyr_ColDenDryAir (0:imax-1, 1:jmax, 0:kmax) ! $ \int_z^{\infty} \rho \, dz $ . ! 鉛直層 k より上空の空気のカラム密度. ! Column density of air above vertical level k. real(DP), intent(in):: xy_SurfAlbedo (0:imax-1, 1:jmax) ! 地表アルベド. ! Surface albedo real(DP), intent(inout):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax) ! 短波 (日射) フラックス. ! Shortwave (insolation) flux ! 作業変数 ! Work variables ! real(DP):: BandWeightSum ! バンドウェイトの和 ! Sum of band weights integer:: k ! 鉛直方向に回る DO ループ用作業変数 ! Work variables for DO loop in vertical direction integer:: bn ! 波長について回る DO ループ用作業変数 ! Work variables for DO loop in wavenumber bands ! 実行文 ; Executable statement ! ! バンドウェイトの設定 ! Configure band weight ! BandWeightSum = 0. do bn = 1, ShortBandNum BandWeightSum = BandWeightSum + ShortBandWeight(bn) end do do bn = 1, ShortBandNum ShortBandWeight(bn) = ShortBandWeight(bn) / BandWeightSum end do do bn = 1, ShortBandNum do k = 0, kmax ! 各レベルでの下向き透過 ! Downward transmission on each level ! if ( k /= kmax ) then xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) + ShortBandWeight(bn) * xyr_RadSFlux(:,:,kmax) * exp( - xy_InAngle(:,:) * ( ShortAbsorpCoefQVap(bn) * xyr_ColDenQVap(:,:,k) + ShortAbsorpCoefDryAir(bn) * xyr_ColDenDryAir(:,:,k) ) ) end if ! 各レベルでの上向き透過 ! Upward transmission on each level ! xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) - ShortBandWeight(bn) * xyr_RadSFlux(:,:,kmax) * exp( - xy_InAngle(:,:) * ( ShortAbsorpCoefQVap(bn) * xyr_ColDenQVap(:,:,0) + ShortAbsorpCoefDryAir(bn) * xyr_ColDenDryAir(:,:,0) ) ) * xy_SurfAlbedo * exp( - ShortSecScat * ( ShortAbsorpCoefQVap(bn) * ( xyr_ColDenQVap(:,:,0) - xyr_ColDenQVap(:,:,k) ) + ShortAbsorpCoefDryAir(bn) * ( xyr_ColDenDryAir(:,:,0) - xyr_ColDenDryAir(:,:,k) ) ) ) end do end do ! 吸収なしの場合 ! In the case of no absorption ! if ( ShortBandNum == 0 ) then do k = 0, kmax xyr_RadSFlux(:,:,k) = ( 1.0_DP - xy_SurfAlbedo ) * xyr_RadSFlux(:,:,kmax) end do end if end subroutine ShortFlux
Variable : | |||
ShortSecScat : | real(DP), save
|
Variable : | |||
flag_rst_input = .false. : | logical, save
|
Variable : | |||
flag_rst_output_end : | logical, save
|
Variable : | |||
gthst_rst : | type(GT_HISTORY), save
|
Constant : | |||
module_name = ‘radiation_DennouAGCM‘ : | character(*), parameter
|
Constant : | |||
version = ’$Name: dcpam5-20100224 $’ // ’$Id: radiation_DennouAGCM.F90,v 1.3 2009-10-19 09:18:56 yot Exp $’ : | character(*), parameter
|
Variable : | |||
xy_InAngle(:,:) : | real(DP), allocatable, save
|
Variable : | |||
xy_IncomRadSFlux(:,:) : | real(DP), allocatable, save
|
Variable : | |||
xy_TempSave(:,:) : | real(DP), allocatable, save
|
Variable : | |||
xyr_RadLFluxSave(:,:,:) : | real(DP), allocatable, save
|
Variable : | |||
xyr_RadSFluxSave(:,:,:) : | real(DP), allocatable, save
|
Variable : | |||
xyra_DelRadLFluxSave(:,:,:,:) : | real(DP), allocatable, save
|