Class radiation_CA81
In: radiation/radiation_CA81.f90

Chou and Arking (1981) による短波放射モデル

Short wave radiation model described by Lacis and Hansen (1974)

Note that Japanese and English are described in parallel.

短波放射モデル.

This is a model of short wave radiation.

References

 Chou, M.-D., and A. Arking, An efficient method for computing the absorption of
   solar radiation by water vapor, J. Atmos. Sci., 38, 798-807, 1981.

Procedures List

!$ ! 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

!$ ! NAMELIST#radiation_DennouAGCM_nml

Methods

Included Modules

dc_types gridset constants namelist_util dc_iounit dc_message

Public Instance methods

Subroutine :
xy_SurfAlbedo(0:imax-1, 1:jmax) :real(DP), intent(in )
xy_InAngle(0:imax-1, 1:jmax) :real(DP), intent(in )
: sec (入射角). sec (angle of incidence)
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)

[Source]

  subroutine RadiationCA81Flux( xy_SurfAlbedo, xy_InAngle, 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

    real(DP), intent(in ):: xy_SurfAlbedo   (0:imax-1, 1:jmax)
    real(DP), intent(in ):: xy_InAngle      (0:imax-1, 1:jmax)
                              ! sec (入射角).
                              ! sec (angle of incidence)
    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):: 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):: xyra_TransH2O   (0:imax-1, 1:jmax, 0:kmax, 1:nlogkmax)

    real(DP):: xy_MagFac       (0:imax-1, 1:jmax)
    real(DP):: xy_cosSZA       (0:imax-1, 1:jmax)

!!$    logical :: flag_dry_atmosphere

    integer :: i
    integer :: j
    integer :: k
    integer :: m


    if ( .not. radiation_ca81_inited ) then
      call RadiationCA81Init
    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


!!$    ! 大気アルベドの考慮
!!$    ! 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 = 300.0d2

    do k = 1, kmax
      xyz_H2ODelAbsAmt(:,:,k) = ( xyz_Press(:,:,k) / RefPress )**H2OScaleIndex * 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


    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)
          xy_cosSZA(i,j) = 1.0d0 / xy_InAngle(i,j)
        else
          xy_MagFac(i,j) = 0.0d0
          xy_cosSZA(i,j) = 0.0d0
        end if
      end do
    end do


    ! Calculation of flux
    !
    xyr_RadSFlux(:,:,:) = 0.0d0


    ! Downward flux
    !
    do k = 0, kmax
      xyr_H2OAbsAmt(:,:,k) = xyr_H2OColDen(:,:,k) * xy_MagFac(:,:)
    end do
    do m = 1, nlogkmax
      xyra_TransH2O(:,:,:,m) = exp( - a_kdfk(m) * xyr_H2OAbsAmt )
    end do
    do m = 1, nlogkmax
      do k = 0, kmax
        xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) - xyra_TransH2O(:,:,k,m) * a_kdfh(m) * kdfdlogk * xy_cosSZA(:,:)
      end do
    end do


    ! Upward flux
    !
    do k = 0, kmax
      xyr_H2OAbsAmt(:,:,k) = xyr_H2OColDen(:,:,0) * xy_MagFac(:,:) + ( xyr_H2OColDen(:,:,0) - xyr_H2OColDen(:,:,k) ) * DiffFactor
    end do
    do m = 1, nlogkmax
      xyra_TransH2O(:,:,:,m) = exp( - a_kdfk(m) * xyr_H2OAbsAmt )
    end do
    do m = 1, nlogkmax
      do k = 0, kmax
        xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) + xyra_TransH2O(:,:,k,m) * a_kdfh(m) * kdfdlogk * xy_cosSZA(:,:) * xy_SurfAlbedo(:,:)
      end do
    end do


!!$    write( 6, * ) '***************************'
!!$    write( 6, * ) '***************************'
!!$    write( 6, * ) '***************************'
!!$    write( 6, * ) 'Short wave radiation out of H2O band is not added in radiation_CA81 module.'
!!$    write( 6, * ) '***************************'
!!$    write( 6, * ) '***************************'
!!$    write( 6, * ) '***************************'
!!$    ! Add flux over wavenumber range except for H2O band, that is treated by 
!!$    ! Chou and Arking (1981) scheme. 
!!$    !
!!$    do k = 0, kmax
!!$      xyr_RadSFlux(:,:,k) = xyr_RadSFlux(:,:,k) &
!!$        & - ( solarconstCA81 - totalfluxoverH2Oband ) * xy_cosSZA(:,:)
!!$    end do

    ! 大気アルベドの考慮
    ! Taking atmospheric albedo into consideration
    !
    xyr_RadSFlux = xyr_RadSFlux * ( 1.0d0 - ShortAtmosAlbedo )


  end subroutine RadiationCA81Flux
Subroutine :
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 )
ikdfbin :integer , intent(in )
xyz_H2ODelOptDep(0:imax-1, 1:jmax, 1:kmax) :real(DP), intent(out)
KDFWeight :real(DP), intent(out)

[Source]

  subroutine RadiationCA81H2ODelOptDep( xyz_QVap, xyr_Press, xyz_Press, ikdfbin, xyz_H2ODelOptDep, KDFWeight )


    ! 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

    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)
    integer , intent(in ):: ikdfbin
    real(DP), intent(out):: xyz_H2ODelOptDep(0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(out):: KDFWeight


    !
    ! Work variables
    !
    real(DP):: RefPress

    real(DP):: xyz_H2ODelAbsAmt(0:imax-1, 1:jmax, 1:kmax)

!!$    logical :: flag_dry_atmosphere

    integer :: k
    integer :: m


    if ( .not. radiation_ca81_inited ) then
      call RadiationCA81Init
    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


    RefPress = 300.0d2

    do k = 1, kmax
      xyz_H2ODelAbsAmt(:,:,k) = ( xyz_Press(:,:,k) / RefPress )**H2OScaleIndex * xyz_QVap(:,:,k) * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
    end do

    m = ikdfbin
    xyz_H2ODelOptDep = xyz_H2ODelAbsAmt * a_kdfk( m )

    KDFWeight = a_kdfh(m) * kdfdlogk


  end subroutine RadiationCA81H2ODelOptDep
Subroutine :
nbin :integer, intent(out)

[Source]

  subroutine RadiationCA81NumKDFBin( nbin )

    integer, intent(out) :: nbin

    if ( .not. radiation_ca81_inited ) then
      call RadiationCA81Init
    end if

    nbin = nlogkmax

  end subroutine RadiationCA81NumKDFBin

Private Instance methods

DiffFactor
Variable :
DiffFactor :real(DP), save
FlagSimpleMagFac
Variable :
FlagSimpleMagFac :logical , save
: エアマス計算のためのフラグ Flag for air-mass calculation
H2OScaleIndex
Variable :
H2OScaleIndex :real(DP), save
Subroutine :

This procedure input/output NAMELIST#radiation_CA81_nml .

[Source]

  subroutine RadiationCA81Init


    ! 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_CA81_nml/ DiffFactor, ShortAtmosAlbedo
          !
          ! デフォルト値については初期化手続 "radiation_LH74#RadiationLH74Init"
          ! のソースコードを参照のこと.
          !
          ! Refer to source codes in the initialization procedure
          ! "radiation_LH74#RadiationLH74Init" for the default values.
          !

    ! デフォルト値の設定
    ! Default values settings
    !
    DiffFactor       = 1.66_DP

    ShortAtmosAlbedo = 0.0_DP

    ! NAMELIST の読み込み
    ! NAMELIST is input
    !
    if ( trim(namelist_filename) /= '' ) then
      call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in)

      rewind( unit_nml )
      read( unit_nml, nml = radiation_CA81_nml, iostat = iostat_nml )             ! (out)
      close( unit_nml )

      call NmlutilMsg( iostat_nml, module_name ) ! (in)
    end if


    H2OScaleIndex = 0.8d0


    ! Unit is changed of k from g-1 cm2 to kg-1 m2.
    !
!!$    a_kdflogk = a_kdflogk + log( 1.0d3 * 1.0d-4 )
    a_kdflogk = a_kdflogk + log10( 1.0d3 * 1.0d-4 )

    ! Unit is changed from mW cm-2 to W m-2.
    !
    a_kdfh    = a_kdfh    * 1.0d-3 * 1.0d4

    ! Calculation of k of table of k-distribution fnction
    !
!!$    a_kdfk    = exp( a_kdflogk )
    a_kdfk    = 10.0d0**a_kdflogk

!!$    ! Unit is changed from mW cm-2 to W m-2.
!!$    !
!!$    aa_kdfhi  = aa_kdfhi  * 1.0d0-3 * 1.0d4

    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, 'DiffFactor       = %f', d = (/ DiffFactor /) )
    call MessageNotify( 'M', module_name, 'ShortAtmosAlbedo = %f', d = (/ ShortAtmosAlbedo /) )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )


    radiation_ca81_inited = .true.
  end subroutine RadiationCA81Init
ShortAtmosAlbedo
Variable :
ShortAtmosAlbedo :real(DP), save
: 大気アルベド. Albedo of air.
a_kdfh
Variable :
a_kdfh(1:nlogkmax) :real(DP), save
a_kdfk
Variable :
a_kdfk(1:nlogkmax) :real(DP), save
:
!$ real(DP), save :aa_kdfhi (1:nlogkmax,1:nbmax)
a_kdflogk
Variable :
a_kdflogk(1:nlogkmax) :real(DP), save
kdfdlogk
Constant :
kdfdlogk = 0.3d0 :real(DP), parameter
module_name
Constant :
module_name = ‘radiation_CA81 :character(*), parameter
: モジュールの名称. Module name
nlogkmax
Constant :
nlogkmax = 30 :integer , parameter
:
!$ integer , parameter:nbmax = 5
radiation_ca81_inited
Variable :
radiation_ca81_inited :logical , save
solarconstCA81
Constant :
solarconstCA81 = 1361.0d0 :real(DP), parameter
totalfluxoverH2Oband
Constant :
totalfluxoverH2Oband = 552.17d0 :real(DP), parameter
version
Constant :
version = ’$Name: dcpam5-20110221-2 $’ // ’$Id: radiation_CA81.f90,v 1.2 2010-12-18 12:56:17 yot Exp $’ :character(*), parameter
: モジュールのバージョン Module version