| Class | rad_CK1991 |
| In: |
radiation/rad_CK1991.F90
|
Note that Japanese and English are described in parallel.
長波放射モデル.
This is a model of long wave radiation.
Chou, M.-D., and L. Kouvaris, Calculations of transmittion functions in the infrared CO2 and O3 bands, J. Geophys. Res., 96, 9003-9012, 1991.
| !$ ! 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) |
!$ ! NAMELIST#radiation_DennouAGCM_nml
| Subroutine : | |
| xyz_DelAbsMass(0:imax-1, 1:jmax, 1:kmax) : | real(DP) , intent(in ) |
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP) , intent(in ) |
| xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP) , intent(in ) |
| Spec : | character(len=*), intent(in ) |
| xyrr_Trans(0:imax-1, 1:jmax, 0:kmax, 0:kmax) : | real(DP) , intent(out) |
subroutine RadCK1991CalcTrans( xyz_DelAbsMass, xyz_Press, xyz_Temp, Spec, xyrr_Trans )
! USE statements
!
real(DP) , intent(in ) :: xyz_DelAbsMass(0:imax-1, 1:jmax, 1:kmax)
real(DP) , intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
real(DP) , intent(in ) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
character(len=*), intent(in ) :: Spec
real(DP) , intent(out) :: xyrr_Trans (0:imax-1, 1:jmax, 0:kmax, 0:kmax)
! 初期化確認
! Initialization check
!
if ( .not. rad_ck1991_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
if ( Spec == 'CO2' ) then
call RadCK1991CalcTransCore( NTabPress, NCO2TabAbsAmt, a_TabLog10Press, a_CO2TabLog10AbsAmt, aa_CO2TabAlpha, aa_CO2TabBeta, aa_CO2TabAbs, xyz_DelAbsMass, xyz_Press, xyz_Temp, xyrr_Trans )
else if ( Spec == 'O3' ) then
call RadCK1991CalcTransCore( NTabPress, NO3TabAbsAmt, a_TabLog10Press, a_O3TabLog10AbsAmt, aa_O3TabAlpha, aa_O3TabBeta, aa_O3TabAbs, xyz_DelAbsMass, xyz_Press, xyz_Temp, xyrr_Trans )
else
call MessageNotify( 'E', module_name, 'Specified composition, %c, is inappropriate', c1 = trim(Spec) )
end if
end subroutine RadCK1991CalcTrans
| Subroutine : |
subroutine RadCK1991Init
! ファイル入出力補助
! File I/O support
!
use dc_iounit, only: FileOpen
!!$ ! NAMELIST ファイル入力に関するユーティリティ
!!$ ! Utilities for NAMELIST file input
!!$ !
!!$ use namelist_util, only: NmlutilMsg, NmlutilAryValid
!!$ integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
!!$ ! Unit number for NAMELIST file open
!!$ integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
!!$ ! IOSTAT of NAMELIST read
!!$ namelist /rad_RL78_nml/ &
!!$ & VMRCO2, &
!!$ & DelTimeCalcTransValue, &
!!$ & DelTimeCalcTransUnit, &
!!$ & flag_save_time
if ( rad_CK1991_inited ) return
!!$
!!$ VMRCO2 = 382.0d-6
!!$
!!$ DelTimeCalcTransValue = 3.0
!!$ DelTimeCalcTransUnit = 'hrs'
!!$ flag_save_time = .false.
!!$
!!$
!!$ ! 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 = rad_RL78_nml, & ! (out)
!!$ & iostat = iostat_nml ) ! (out)
!!$ close( unit_nml )
!!$
!!$ call NmlutilMsg( iostat_nml, module_name ) ! (in)
!!$ end if
! Convert unit of pressure from mbar to Pa
!
a_TabLog10Press = 10.0d0**a_TabLog10Press
a_TabLog10Press = a_TabLog10Press * 1.0d2
a_TabLog10Press = log10( a_TabLog10Press )
! Convert unit of absorber amount from (atm cm)_{STP} to kg m-2
! To convert from (atm cm)_{STP} to kg m-2, the value is divided by
! 1.0d2 / 101325.0d0 * 8.31432d0 / ( 44.0d-3 ) * 273.15d0, and
! 1.0d2 / 101325.0d0 * 8.31432d0 / ( 48.0d-3 ) * 273.15d0,
! for CO2 and O3, respectively.
! MEMO: In a calculation below, GasRUniv variable in constants module can be used.
! But, I do not use it, since unit of value is just converted by
! multiplying a factor. Of course, non-use of GasRUniv must not cause
! significant effect on result.
!
a_CO2TabLog10AbsAmt = 10.0d0**a_CO2TabLog10AbsAmt
a_CO2TabLog10AbsAmt = a_CO2TabLog10AbsAmt / ( 1.0d2 / 101325.0d0 * 8.31432d0 / ( 44.0d-3 ) * 273.15d0 )
a_CO2TabLog10AbsAmt = log10( a_CO2TabLog10AbsAmt )
!
a_O3TabLog10AbsAmt = 10.0d0**a_O3TabLog10AbsAmt
a_O3TabLog10AbsAmt = a_O3TabLog10AbsAmt / ( 1.0d2 / 101325.0d0 * 8.31432d0 / ( 48.0d-3 ) * 273.15d0 )
a_O3TabLog10AbsAmt = log10( a_O3TabLog10AbsAmt )
!
! Convert values absorptance from -1e3 * log10(A) to log10(A)
!
aa_CO2TabAbs = 10.0d0**( aa_CO2TabAbs / ( -1.0d3 ) )
aa_CO2TabAbs = log10( aa_CO2TabAbs )
!
aa_O3TabAbs = 10.0d0**( aa_O3TabAbs / ( -1.0d3 ) )
aa_O3TabAbs = log10( aa_O3TabAbs )
!
! Convert values of alpha absorptance from 1e4 * alpha to alpha
!
aa_CO2TabAlpha = aa_CO2TabAlpha / ( 1.0d4 )
!
aa_O3TabAlpha = aa_O3TabAlpha / ( 1.0d4 )
!
! Convert values of beta absorptance from 1e6 * beta to beta
!
aa_CO2TabBeta = aa_CO2TabBeta / ( 1.0d6 )
!
aa_O3TabBeta = aa_O3TabBeta / ( 1.0d6 )
! 印字 ; Print
!
call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
!!$ call MessageNotify( 'M', module_name, ' DelTimeCalcTrans = %f [%c]', &
!!$ & d = (/ DelTimeCalcTransValue /), c1 = trim( DelTimeCalcTransUnit ) )
call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )
rad_ck1991_inited = .true.
end subroutine RadCK1991Init
| Subroutine : | |
| NTabPress : | integer , intent(in ) |
| NTabAbsAmt : | integer , intent(in ) |
| a_TabLog10Press(NTabPress ) : | real(DP), intent(in ) |
| a_TabLog10AbsAmt(NTabAbsAmt) : | real(DP), intent(in ) |
| aa_Tab(NTabAbsAmt, NTabPress) : | real(DP), intent(in ) |
| xy_IndexPress(0:imax-1, 1:jmax) : | integer , intent(in ) |
| xy_IndexAbsAmt(0:imax-1, 1:jmax) : | integer , intent(in ) |
| xy_Log10Press(0:imax-1, 1:jmax) : | real(DP), intent(in ) |
| xy_Log10AbsAmt(0:imax-1, 1:jmax) : | real(DP), intent(in ) |
| xy_Array(0:imax-1, 1:jmax) : | real(DP), intent(out) |
subroutine RadCK1991Interpolate( NTabPress, NTabAbsAmt, a_TabLog10Press, a_TabLog10AbsAmt, aa_Tab, xy_IndexPress, xy_IndexAbsAmt, xy_Log10Press, xy_Log10AbsAmt, xy_Array )
! USE statements
!
integer , intent(in ) :: NTabPress
integer , intent(in ) :: NTabAbsAmt
real(DP), intent(in ) :: a_TabLog10Press (NTabPress )
real(DP), intent(in ) :: a_TabLog10AbsAmt(NTabAbsAmt)
real(DP), intent(in ) :: aa_Tab (NTabAbsAmt, NTabPress)
integer , intent(in ) :: xy_IndexPress (0:imax-1, 1:jmax)
integer , intent(in ) :: xy_IndexAbsAmt (0:imax-1, 1:jmax)
real(DP), intent(in ) :: xy_Log10Press (0:imax-1, 1:jmax)
real(DP), intent(in ) :: xy_Log10AbsAmt (0:imax-1, 1:jmax)
real(DP), intent(out) :: xy_Array (0:imax-1, 1:jmax)
!
! Work variables
!
real(DP) :: val1
real(DP) :: val2
integer :: ip1
integer :: ip2
integer :: iw1
integer :: iw2
integer :: i
integer :: j
! 初期化確認
! Initialization check
!
if ( .not. rad_ck1991_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
do j = 1, jmax
do i = 0, imax-1
ip1 = xy_IndexPress (i,j) - 1
ip2 = xy_IndexPress (i,j)
iw1 = xy_IndexAbsAmt(i,j) - 1
iw2 = xy_IndexAbsAmt(i,j)
val1 = ( aa_Tab (iw2,ip1) - aa_Tab (iw1,ip1) ) / ( a_TabLog10AbsAmt(iw2) - a_TabLog10AbsAmt(iw1) ) * ( xy_Log10AbsAmt (i,j) - a_TabLog10AbsAmt(iw1) ) + aa_Tab (iw1,ip1)
val2 = ( aa_Tab (iw2,ip2) - aa_Tab (iw1,ip2) ) / ( a_TabLog10AbsAmt(iw2) - a_TabLog10AbsAmt(iw1) ) * ( xy_Log10AbsAmt (i,j) - a_TabLog10AbsAmt(iw1) ) + aa_Tab (iw1,ip2)
xy_Array(i,j) = ( val2 - val1 ) / ( a_TabLog10Press(ip2) - a_TabLog10Press(ip1) ) * ( xy_Log10Press (i,j) - a_TabLog10Press(ip1) ) + val1
end do
end do
end subroutine RadCK1991Interpolate
| Subroutine : | |
| NTabPress : | integer , intent(in ) |
| NTabAbsAmt : | integer , intent(in ) |
| a_TabLog10Press(NTabPress ) : | real(DP), intent(in ) |
| a_TabLog10AbsAmt(NTabAbsAmt) : | real(DP), intent(in ) |
| aa_TabAlpha(NTabAbsAmt, NTabPress) : | real(DP), intent(in ) |
| aa_TabBeta(NTabAbsAmt, NTabPress) : | real(DP), intent(in ) |
| aa_TabAbs(NTabAbsAmt, NTabPress) : | real(DP), intent(in ) |
| xyz_DelAbsMass(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_Press(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyz_Temp(0:imax-1, 1:jmax, 1:kmax) : | real(DP), intent(in ) |
| xyrr_Trans(0:imax-1, 1:jmax, 0:kmax, 0:kmax) : | real(DP), intent(out) |
subroutine RadCK1991CalcTransCore( NTabPress, NTabAbsAmt, a_TabLog10Press, a_TabLog10AbsAmt, aa_TabAlpha, aa_TabBeta, aa_TabAbs, xyz_DelAbsMass, xyz_Press, xyz_Temp, xyrr_Trans )
! USE statements
!
integer , intent(in ) :: NTabPress
integer , intent(in ) :: NTabAbsAmt
real(DP), intent(in ) :: a_TabLog10Press (NTabPress )
real(DP), intent(in ) :: a_TabLog10AbsAmt(NTabAbsAmt)
real(DP), intent(in ) :: aa_TabAlpha (NTabAbsAmt, NTabPress)
real(DP), intent(in ) :: aa_TabBeta (NTabAbsAmt, NTabPress)
real(DP), intent(in ) :: aa_TabAbs (NTabAbsAmt, NTabPress)
real(DP), intent(in ) :: xyz_DelAbsMass (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_Press (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(in ) :: xyz_Temp (0:imax-1, 1:jmax, 1:kmax)
real(DP), intent(out) :: xyrr_Trans (0:imax-1, 1:jmax, 0:kmax, 0:kmax)
!
! Work variables
!
real(DP), parameter :: RefTemp = 250.0_DP
real(DP) :: xy_EffTemp (0:imax-1, 1:jmax)
real(DP) :: xy_EffPress (0:imax-1, 1:jmax)
real(DP) :: xy_AbsAmt (0:imax-1, 1:jmax)
real(DP) :: xy_Log10EffPress(0:imax-1, 1:jmax)
real(DP) :: xy_Log10AbsAmt (0:imax-1, 1:jmax)
integer :: xy_IndexPress (0:imax-1, 1:jmax)
integer :: xy_IndexAbsAmt (0:imax-1, 1:jmax)
real(DP) :: xy_Alpha (0:imax-1, 1:jmax)
real(DP) :: xy_Beta (0:imax-1, 1:jmax)
real(DP) :: xy_AbsAtRefTemp (0:imax-1, 1:jmax)
real(DP) :: xy_Abs (0:imax-1, 1:jmax)
integer :: i
integer :: j
integer :: k
integer :: kk
integer :: l
! 初期化確認
! Initialization check
!
if ( .not. rad_ck1991_inited ) then
call MessageNotify( 'E', module_name, 'This module has not been initialized.' )
end if
do k = 0, kmax
do kk = k+1, kmax
xy_EffTemp = 0.0_DP
xy_EffPress = 0.0_DP
xy_AbsAmt = 0.0_DP
do l = k+1, kk
xy_EffTemp = xy_EffTemp + xyz_Temp (:,:,l) * xyz_DelAbsMass(:,:,l)
xy_EffPress = xy_EffPress + xyz_Press(:,:,l) * xyz_DelAbsMass(:,:,l)
xy_AbsAmt = xy_AbsAmt + xyz_DelAbsMass(:,:,l)
end do
xy_EffTemp = xy_EffTemp / ( xy_AbsAmt + 1.0d-100 )
xy_EffPress = xy_EffPress / ( xy_AbsAmt + 1.0d-100 )
xy_Log10EffPress = log10( xy_EffPress + 1.0d-100 )
xy_Log10AbsAmt = log10( xy_AbsAmt + 1.0d-100 )
do j = 1, jmax
do i = 0, imax-1
if ( xy_Log10EffPress(i,j) < a_TabLog10Press (1) ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'at k = %d and kk = %d, Log10EffPress(%d,%d) = %f < %f. too small', &
!!$ & i = (/k, kk, i, j/), &
!!$ & d = (/xy_Log10EffPress(i,j), a_TabLog10Press(1)/) )
xy_IndexPress(i,j) = 2
else
#ifdef VECTOR
xy_IndexPress(i,j) = 1 + 1
Loop_Search_Press : do l = 1+1, NTabPress-1
if ( a_TabLog10Press (l) < xy_Log10EffPress(i,j) ) then
xy_IndexPress(i,j) = l + 1
end if
end do Loop_Search_Press
#else
Loop_Search_Press : do l = 1+1, NTabPress
if ( a_TabLog10Press (l) > xy_Log10EffPress(i,j) ) then
exit Loop_Search_Press
end if
end do Loop_Search_Press
if ( l > NTabPress ) then
l = NTabPress
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'at k = %d and kk = %d, Log10EffPress(%d,%d) = %f > %f. too large', &
!!$ & i = (/k, kk, i, j/), &
!!$ & d = (/xy_Log10EffPress(i,j), a_TabLog10Press(NTabPress)/) )
end if
xy_IndexPress(i,j) = l
#endif
end if
if ( xy_Log10AbsAmt(i,j) < a_TabLog10AbsAmt(1) ) then
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'at k = %d and kk = %d, Log10AbsAmt(%d,%d) = %f < %f. too small', &
!!$ & i = (/k, kk, i, j/), &
!!$ & d = (/xy_Log10AbsAmt(i,j), a_TabLog10AbsAmt(1)/) )
xy_IndexAbsAmt(i,j) = 2
else
#ifdef VECTOR
xy_IndexAbsAmt(i,j) = 1 + 1
Loop_Search_AbsAmt : do l = 1+1, NTabAbsAmt-1
if ( a_TabLog10AbsAmt(l) < xy_Log10AbsAmt(i,j) ) then
xy_IndexAbsAmt(i,j) = l + 1
end if
end do Loop_Search_AbsAmt
#else
Loop_Search_AbsAmt : do l = 1+1, NTabAbsAmt
if ( a_TabLog10AbsAmt(l) > xy_Log10AbsAmt(i,j) ) then
exit Loop_Search_AbsAmt
end if
end do Loop_Search_AbsAmt
if ( l > NTabAbsAmt ) then
l = NTabAbsAmt
!!$ call MessageNotify( 'E', module_name, &
!!$ & 'at k = %d and kk = %d, Log10AbsAmt(%d,%d) = %f > %f. too large', &
!!$ & i = (/k, kk, i, j/), &
!!$ & d = (/xy_Log10AbsAmt(i,j), a_TabLog10AbsAmt(NTabAbsAmt)/) )
end if
xy_IndexAbsAmt(i,j) = l
#endif
end if
end do
end do
call RadCK1991Interpolate( NTabPress, NTabAbsAmt, a_TabLog10Press, a_TabLog10AbsAmt, aa_TabAlpha, xy_IndexPress, xy_IndexAbsAmt, xy_Log10EffPress, xy_Log10AbsAmt, xy_Alpha )
call RadCK1991Interpolate( NTabPress, NTabAbsAmt, a_TabLog10Press, a_TabLog10AbsAmt, aa_TabBeta, xy_IndexPress, xy_IndexAbsAmt, xy_Log10EffPress, xy_Log10AbsAmt, xy_Beta )
call RadCK1991Interpolate( NTabPress, NTabAbsAmt, a_TabLog10Press, a_TabLog10AbsAmt, aa_TabAbs, xy_IndexPress, xy_IndexAbsAmt, xy_Log10EffPress, xy_Log10AbsAmt, xy_AbsAtRefTemp )
xy_AbsAtRefTemp = 10.0d0**xy_AbsAtRefTemp
xy_Abs = xy_AbsAtRefTemp * ( 1.0_DP + xy_Alpha * ( xy_EffTemp - RefTemp ) + xy_Beta * ( xy_EffTemp - RefTemp )**2 )
xyrr_Trans(:,:,k,kk) = 1.0_DP - xy_Abs
end do
end do
!
! correction
!
do k = 0, kmax
do kk = k+2, kmax
do j = 1, jmax
do i = 0, imax-1
if ( xyrr_Trans(i,j,k,kk) > xyrr_Trans(i,j,k,kk-1) ) then
xyrr_Trans(i,j,k,kk) = xyrr_Trans(i,j,k,kk-1)
end if
end do
end do
end do
end do
do k = 0, kmax
do kk = 0, k-1
xyrr_Trans(:,:,k,kk) = xyrr_Trans(:,:,kk,k)
end do
kk = k
xyrr_Trans(:,:,k,kk) = 1.0_DP
end do
end subroutine RadCK1991CalcTransCore
| Variable : | |||
| rad_ck1991_inited = .false. : | logical, save
|
| Constant : | |||
| version = ’$Name: $’ // ’$Id: rad_CK1991.F90,v 1.2 2013/01/18 02:35:37 yot Exp $’ : | character(*), parameter
|