| Class | radiation_LH74 |
| In: |
radiation/radiation_LH74.f90
|
Note that Japanese and English are described in parallel.
短波放射モデル.
This is a model of short wave radiation.
Lacis, A. A., and J. E. Hansen, A parameterization for the absorption of solar radiation in the Earth's atmosphere, J. Atmos. Sci., 31, 118-133, 1974.
| !$ ! 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 : | |
| xyz_QO3(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xy_SurfAlbedo(0:imax-1, 1:jmax) : | real(DP), intent(in ) |
| xyr_Press(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ) |
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_DTempDtRadS(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(inout) |
Lacis and Hansen (1974) の計算方を用いて O3 の短波吸収加熱率を計算し, 短波放射加熱率に加える.
Calculate radiative heating rate due to absorption of short wave radiation of O3 and add to the short wave radiative heating rate
subroutine RadiationLH74AddO3Heating( xyz_QO3, xy_SurfAlbedo, xyr_Press, xyz_Press, xyz_DTempDtRadS )
!
! Lacis and Hansen (1974) の計算方を用いて O3 の短波吸収加熱率を計算し,
! 短波放射加熱率に加える.
!
! Calculate radiative heating rate due to absorption of short wave radiation of O3
! and add to the short wave radiative heating rate
!
! USE statements
!
!
! Grid points settings
!
use gridset, only: imax, jmax, kmax !
! Number of vertical level
!
! Physical constants settings
!
use constants, only: Grav, PI, CpDry ! $ C_p $ [J kg-1 K-1].
! 乾燥大気の定圧比熱.
! Specific heat of air at constant pressure
! 短波入射 (太陽入射)
! Short wave (insolation) incoming
!
use radiation_short_income, only: ShortIncoming
! use radiation_short_income_sr, only: ShortIncoming
!!$ ! 時刻管理
!!$ ! Time control
!!$ !
!!$ use timeset, only: &
!!$ & TimeN ! ステップ $ t $ の時刻.
!!$ ! Time of step $ t $.
use read_time_series, only: SetValuesFromTimeSeriesWrapper
!!$ ! ヒストリデータ出力
!!$ ! History data output
!!$ !
!!$ use gtool_historyauto, only: HistoryAutoAddVariable, HistoryAutoPut
real(DP), intent(in ):: xyz_QO3 (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ):: xy_SurfAlbedo (0:imax-1, 1:jmax)
real(DP), intent(in ):: xyr_Press (0:imax-1, 1:jmax, 0:kmax)
real(DP), intent(in ):: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(inout):: xyz_DTempDtRadS(0:imax-1, 1:jmax, 1:kmax)
!
! Work variables
!
real(DP):: xyz_O3DelAbsAmt (0:imax-1, 1:jmax, 1:kmax)
real(DP):: xyr_O3ColDen (0:imax-1, 1:jmax, 0:kmax)
real(DP):: xyr_O3AbsAmt (0:imax-1, 1:jmax, 0:kmax)
real(DP):: xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax)
real(DP):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax)
real(DP):: xy_IncomRadSFlux(0:imax-1, 1:jmax)
! 短波 (日射) フラックス.
! Short wave (insolation) flux
real(DP):: xy_InAngle (0:imax-1, 1:jmax)
! sec (入射角).
! sec (angle of incidence)
real(DP):: xy_MagFac (0:imax-1, 1:jmax)
!!$ logical :: flag_dry_atmosphere
character(STRING):: O3FileName
integer :: i
integer :: j
integer :: k
if ( .not. radiation_lh74_inited ) then
call RadiationLH74Init
end if
!!$ write( O3FileName, '(a,i3.3,a)' ) &
!!$ & "../../../data_Earth/O3_CMIP5_climatology_zonalmean_T", (imax-1)/3, ".nc"
!!$ call SetValuesFromTimeSeriesWrapper( &
!!$ & O3FileName, "O3", &
!!$ & xyz_Press, & ! (in)
!!$ & xyz_QO3, & ! (inout)
!!$ & "O3" &
!!$ & )
!!$
!!$ call HistoryAutoPut( TimeN, "O3", xyz_QO3 )
! 短波入射の計算
! Calculate short wave (insolation) incoming radiation
!
call ShortIncoming( xy_IncomRadSFlux, xy_InAngle )
do k = 1, kmax
xyz_O3DelAbsAmt(:,:,k) = xyz_QO3(:,:,k) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
end do
xyr_O3ColDen(:,:,:) = 0.0d0
do k = kmax-1, 0, -1
xyr_O3ColDen(:,:,k) = xyr_O3ColDen(:,:,k+1) + xyz_O3DelAbsAmt(:,:,k+1)
end do
if ( FlagSimpleMagFac ) then
do j = 1, jmax
do i = 0, imax-1
if ( xy_InAngle(i,j) > 0.0d0 ) then
xy_MagFac(i,j) = xy_InAngle(i,j)
else
xy_MagFac(i,j) = 0.0d0
end if
end do
end do
else
do j = 1, jmax
do i = 0, imax-1
if ( xy_InAngle(i,j) > 0.0d0 ) then
xy_MagFac(i,j) = 35.0d0 / sqrt( 1224.0d0 * ( 1.0d0 / xy_InAngle(i,j) )**2 + 1.0d0 )
else
xy_MagFac(i,j) = 0.0d0
end if
end do
end do
end if
xyr_RadSFlux(:,:,:) = 0.0d0
! Downward flux
do k = 0, kmax
xyr_O3AbsAmt(:,:,k) = xyr_O3ColDen(:,:,k) * xy_MagFac(:,:)
end do
call RadiationLH74CalcO3Absorptivity( xyr_O3AbsAmt, xyr_Absorptivity )
do k = 0, kmax
xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) + xy_IncomRadSFlux(:,:) * ( 1.0d0 - xyr_Absorptivity(:,:,k) )
end do
! Upward flux
do k = 0, kmax
xyr_O3AbsAmt(:,:,k) = xyr_O3ColDen(:,:,0) * xy_MagFac(:,:) + ( xyr_O3ColDen(:,:,0) - xyr_O3ColDen(:,:,k) ) * DiffFactorO3
end do
call RadiationLH74CalcO3Absorptivity( xyr_O3AbsAmt, xyr_Absorptivity )
do k = 0, kmax
xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) - xy_IncomRadSFlux(:,:) * xy_SurfAlbedo(:,:) * ( 1.0d0 - xyr_Absorptivity(:,:,k) )
end do
! 放射加熱率の計算
! Calculate radiation heating rate
!
do k = 1, kmax
xyz_DTempDtRadS(:,:,k) = xyz_DTempDtRadS(:,:,k) + ( xyr_RadSFlux(:,:,k-1) - xyr_RadSFlux(:,:,k) ) / ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / CpDry * Grav
end do
!!$ i = imax / 2
!!$ j = jmax / 2
!!$ j = jmax * 3 / 4
!!$ do k = 0, kmax
!!$ write( 93, * ) xyr_RadSFlux(i,j,k), xyr_Press(i,j,k)
!!$ end do
!!$ call flush( 93 )
!!$
!!$ do k = 1, kmax
!!$ write( 83, * ) &
!!$ & + ( xyr_RadSFlux(i,j,k-1) - xyr_RadSFlux(i,j,k) ) &
!!$ & / ( xyr_Press(i,j,k-1) - xyr_Press(i,j,k) ) &
!!$ & / CpDry * Grav, &
!!$ & xyz_Press(i,j,k)
!!$ end do
!!$ call flush( 83 )
!!$
!!$
!!$ stop
end subroutine RadiationLH74AddO3Heating
| Subroutine : | |
| xy_SurfAlbedo(0:imax-1, 1:jmax) : | real(DP), intent(in ) |
| 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 ) |
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyr_RadSFlux(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out) |
subroutine RadiationLH74Flux( xy_SurfAlbedo, xyz_Temp, xyz_QVap, xyr_Press, xyz_Press, xyr_RadSFlux )
! USE statements
!
!
! Grid points settings
!
use gridset, only: imax, jmax, kmax !
! Number of vertical level
!
! Physical constants settings
!
use constants, only: Grav, PI ! $ \pi $ .
! Circular constant
! 短波入射 (太陽入射)
! Short wave (insolation) incoming
!
use radiation_short_income, only: ShortIncoming
! use radiation_short_income_sr, only: ShortIncoming
real(DP), intent(in ):: xy_SurfAlbedo (0:imax-1, 1:jmax)
real(DP), intent(in ):: 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 ):: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out):: xyr_RadSFlux (0:imax-1, 1:jmax, 0:kmax)
!
! Work variables
!
real(DP):: RefPress
real(DP):: RefTemp
real(DP):: xyz_H2ODelAbsAmt(0:imax-1, 1:jmax, 1:kmax)
real(DP):: xyr_H2OColDen (0:imax-1, 1:jmax, 0:kmax)
real(DP):: xyr_H2OAbsAmt (0:imax-1, 1:jmax, 0:kmax)
real(DP):: xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax)
real(DP):: xy_IncomRadSFlux(0:imax-1, 1:jmax)
! 短波 (日射) フラックス.
! Short wave (insolation) flux
real(DP):: xy_InAngle (0:imax-1, 1:jmax)
! sec (入射角).
! sec (angle of incidence)
real(DP):: xy_MagFac (0:imax-1, 1:jmax)
!!$ logical :: flag_dry_atmosphere
integer :: i
integer :: j
integer :: k
if ( .not. radiation_lh74_inited ) then
call RadiationLH74Init
end if
!!$ ! Check for dry atmosphere
!!$ !
!!$ if ( all( xyz_QVap <= 0.0d0 ) ) then
!!$ flag_dry_atmosphere = .true.
!!$ write( 6, * ) 'Dry atmosphere'
!!$ else
!!$ flag_dry_atmosphere = .false.
!!$ end if
! 短波入射の計算
! Calculate short wave (insolation) incoming radiation
!
call ShortIncoming( xy_IncomRadSFlux, xy_InAngle )
! 大気アルベドの考慮
! Taking atmospheric albedo into consideration
!
xy_IncomRadSFlux = xy_IncomRadSFlux * ( 1.0d0 - ShortAtmosAlbedo )
!!$ if ( flag_dry_atmosphere ) then
!!$ do k = 0, kmax
!!$ xyr_RadSFlux(:,:,k) = - xy_IncomRadSFlux(:,:) + ...
!!$ end do
!!$ return
!!$ end if
RefPress = 1.013d5
RefTemp = 273.0d0
do k = 1, kmax
xyz_H2ODelAbsAmt(:,:,k) = ( xyz_Press(:,:,k) / RefPress )**H2OScaleIndex * ( RefTemp / xyz_Temp(:,:,k) )**0.5 * xyz_QVap(:,:,k) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
!!$ xyz_H2ODelAbsAmt(:,:,k) = &
!!$ & ( xyz_Press(:,:,k) / RefPress ) &
!!$ & * xyz_QVap(:,:,k) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
end do
xyr_H2OColDen(:,:,:) = 0.0d0
do k = kmax-1, 0, -1
xyr_H2OColDen(:,:,k) = xyr_H2OColDen(:,:,k+1) + xyz_H2ODelAbsAmt(:,:,k+1)
end do
if ( FlagSimpleMagFac ) then
do j = 1, jmax
do i = 0, imax-1
if ( xy_InAngle(i,j) > 0.0d0 ) then
xy_MagFac(i,j) = xy_InAngle(i,j)
else
xy_MagFac(i,j) = 0.0d0
end if
end do
end do
else
do j = 1, jmax
do i = 0, imax-1
if ( xy_InAngle(i,j) > 0.0d0 ) then
xy_MagFac(i,j) = 35.0d0 / sqrt( 1224.0d0 * ( 1.0d0 / xy_InAngle(i,j) )**2 + 1.0d0 )
else
xy_MagFac(i,j) = 0.0d0
end if
end do
end do
end if
xyr_RadSFlux(:,:,:) = 0.0d0
! Downward flux
do k = 0, kmax
xyr_H2OAbsAmt(:,:,k) = xyr_H2OColDen(:,:,k) * xy_MagFac(:,:)
end do
call RadiationLH74CalcAbsorptivity( xyr_H2OAbsAmt, xyr_Absorptivity )
do k = 0, kmax
xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) + xy_IncomRadSFlux(:,:) * ( 1.0d0 - xyr_Absorptivity(:,:,k) )
end do
! Upward flux
do k = 0, kmax
xyr_H2OAbsAmt(:,:,k) = xyr_H2OColDen(:,:,0) * xy_MagFac(:,:) + ( xyr_H2OColDen(:,:,0) - xyr_H2OColDen(:,:,k) ) * DiffFactorH2O
end do
call RadiationLH74CalcAbsorptivity( xyr_H2OAbsAmt, xyr_Absorptivity )
do k = 0, kmax
xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) - xy_IncomRadSFlux(:,:) * xy_SurfAlbedo(:,:) * ( 1.0d0 - xyr_Absorptivity(:,:,k) )
end do
end subroutine RadiationLH74Flux
| Variable : | |||
| FlagSimpleMagFac : | logical , save
|
| Subroutine : | |
| xyr_H2OAbsAmt(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ) |
| xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out) |
subroutine RadiationLH74CalcAbsorptivity( xyr_H2OAbsAmt, xyr_Absorptivity )
! USE statements
!
!
! Grid points settings
!
use gridset, only: imax, jmax, kmax !
! Number of vertical level
real(DP), intent(in ):: xyr_H2OAbsAmt (0:imax-1, 1:jmax, 0:kmax)
real(DP), intent(out):: xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax)
!
! Work variables
!
real(DP):: xyr_H2Oprcm(0:imax-1, 1:jmax, 0:kmax)
xyr_H2Oprcm(:,:,:) = xyr_H2OAbsAmt(:,:,:) / ( 1.0d0 * 1.0d-3 * 1.0d6 ) * 1.0d2
xyr_Absorptivity(:,:,:) = 2.9d0 * xyr_H2Oprcm(:,:,:) / ( ( 1.0d0 + 141.5d0 * xyr_H2Oprcm(:,:,:) )**0.635 + 5.925d0 * xyr_H2Oprcm(:,:,:) )
end subroutine RadiationLH74CalcAbsorptivity
| Subroutine : | |
| xyr_O3AbsAmt(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(in ) |
| xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax) : | real(DP), intent(out) |
subroutine RadiationLH74CalcO3Absorptivity( xyr_O3AbsAmt, xyr_Absorptivity )
! USE statements
!
! 物理定数設定
! Physical constants settings
!
use constants, only: GasRUniv
! $ R^{*} $ [J K-1 mol-1].
! 普遍気体定数. Universal gas constant
!
! Grid points settings
!
use gridset, only: imax, jmax, kmax !
! Number of vertical level
real(DP), intent(in ):: xyr_O3AbsAmt (0:imax-1, 1:jmax, 0:kmax)
real(DP), intent(out):: xyr_Absorptivity(0:imax-1, 1:jmax, 0:kmax)
!
! Work variables
!
real(DP):: O3DensNTP
real(DP):: xyr_O3cm(0:imax-1, 1:jmax, 0:kmax)
O3DensNTP = 1013.25d2 / ( GasRUniv / 48.0d-3 * 273.15d0 )
xyr_O3cm(:,:,:) = xyr_O3AbsAmt(:,:,:) / O3DensNTP * 1.0d2
xyr_Absorptivity(:,:,:) = 0.02118d0 * xyr_O3cm(:,:,:) / ( 1.0d0 + 0.042d0 * xyr_O3cm(:,:,:) + 0.000323d0 * xyr_O3cm(:,:,:) * xyr_O3cm(:,:,:) ) + 1.082d0 * xyr_O3cm(:,:,:) / ( 1.0d0 + 138.6d0 * xyr_O3cm(:,:,:) )**0.805 + 0.0658d0 * xyr_O3cm(:,:,:) / ( 1.0d0 + ( 103.6d0 * xyr_O3cm(:,:,:) )**3 )
end subroutine RadiationLH74CalcO3Absorptivity
| Subroutine : |
This procedure input/output NAMELIST#radiation_LH74_nml .
subroutine RadiationLH74Init
! NAMELIST ファイル入力に関するユーティリティ
! Utilities for NAMELIST file input
!
use namelist_util, only: namelist_filename, NmlutilMsg
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
! メッセージ出力
! Message output
!
use dc_message, only: MessageNotify
!!$ ! ヒストリデータ出力
!!$ ! History data output
!!$ !
!!$ use gtool_historyauto, only: HistoryAutoAddVariable
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
! NAMELIST 変数群
! NAMELIST group name
!
namelist /radiation_LH74_nml/ DiffFactorH2O, DiffFactorO3, ShortAtmosAlbedo, FlagSimpleMagFac
!
! デフォルト値については初期化手続 "radiation_LH74#RadiationLH74Init"
! のソースコードを参照のこと.
!
! Refer to source codes in the initialization procedure
! "radiation_LH74#RadiationLH74Init" for the default values.
!
! デフォルト値の設定
! Default values settings
!
DiffFactorH2O = 5.0d0 / 3.0d0
DiffFactorO3 = 1.9_DP
ShortAtmosAlbedo = 0.2_DP
FlagSimpleMagFac = .false.
! 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_LH74_nml, iostat = iostat_nml ) ! (out)
close( unit_nml )
call NmlutilMsg( iostat_nml, module_name ) ! (in)
end if
H2OScaleIndex = 1.0d0
!!$ call HistoryAutoAddVariable( "O3", & ! (in)
!!$ & (/ 'lon ', 'lat ', 'sig ', 'time' /), & ! (in)
!!$ & "ozone", 'kg kg-1' ) ! (in)
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
call MessageNotify( 'M', module_name, 'DiffFactorH2O = %f', d = (/ DiffFactorH2O /) )
call MessageNotify( 'M', module_name, 'DiffFactorO3 = %f', d = (/ DiffFactorO3 /) )
call MessageNotify( 'M', module_name, 'ShortAtmosAlbedo = %f', d = (/ ShortAtmosAlbedo /) )
call MessageNotify( 'M', module_name, 'FlagSimpleMagFac = %b', l = (/ FlagSimpleMagFac /) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
radiation_lh74_inited = .true.
end subroutine RadiationLH74Init
| Constant : | |||
| module_name = ‘radiation_LH74‘ : | character(*), parameter
|
| Constant : | |||
| version = ’$Name: dcpam5-20100224 $’ // ’$Id: radiation_LH74.f90,v 1.3 2010-01-11 01:38:49 yot Exp $’ : | character(*), parameter
|