dcpam 地球大気向け長波放射モデル Ver. 2.3

dcpam long wave radiation model for the Earth‘s atmosphere Ver. 2.3

Note that Japanese and English are described in parallel.

長波放射モデル.

This is a model of long wave radiation for the Earth‘s atmospehre. Radiation in the wavenumber range from 0 to 3000 cm-1 is calculated following the scheme by Chou et al. (2001).

References

 Chou, M.-D., M. J. Suarez, X.-Z. Liang, and M. M.-H. Yan,
   A thermal infrared radiation parameterization for atmospheric studies,
   NASA Technical Report Series on Global Modeling and Data Assimilation,
   19, NASA/TM-2001-104606, 2001.

Procedures List

RadiationDcpamELWV23Flux :	放射フラックスの計算
———— :	————
RadiationDcpamELWV23Flux :	Calculate radiation flux

NAMELIST

NAMELIST#radiation_dcpam_E_LW_V2_3_nml

Methods

CO2MolWeight CalcIntegratedPFWithTable2D CalcIntegratedPFWithTable3D CloudIceREff CloudWatREff DiffFactor FlagHighAlt FlagTransSaved H2OMolWeight IntTimeSave MeanMolWeight PrevTimeSave RadiationDcpamELWV23Flux RadiationDcpamELWV23Init RadiationDcpamELWV23PrepPFTable TableTempIncrement TableTempMax TableTempMin VMRCO2 a_TableTemp aa_BandParam aa_TableIDPFDT aa_TableIPF flag_save_time module_name nbmax ntmax radiation_dcpam_E_LW_V2_3_inited version xyrr_TransMASaved xyrra_TransSaved

Included Modules

dc_types gridset dc_message timeset constants radiation_CK1991 radiation_C2001 radiation_utils dc_iounit namelist_util dc_calendar gauss_quad planck_func

Public Instance methods

RadiationDcpamELWV23Flux( xyz_Press, xyr_Press, xyz_Temp, xy_SurfTemp, xyz_QH2OVap, xyz_QH2OLiq, xyz_QH2OSol, xyz_QO3, xyr_RadLFlux, xyra_DelRadLFlux )

*Subroutine* :
`xyz_Press(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_Temp(0:imax-1, 1:jmax, 1:kmax)` :	`real(DP), intent(in )`
`xy_SurfTemp(0:imax-1, 1:jmax)` :	`real(DP), intent(in )`
`xyz_QH2OVap(0:imax-1, 1:jmax, 1:kmax)` :	`real(DP), intent(in )`
`xyz_QH2OLiq(0:imax-1, 1:jmax, 1:kmax)` :	`real(DP), intent(in )`
`xyz_QH2OSol(0:imax-1, 1:jmax, 1:kmax)` :	`real(DP), intent(in )`
`xyz_QO3(0:imax-1, 1:jmax, 1: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)`

[Source]

  subroutine RadiationDcpamELWV23Flux( xyz_Press, xyr_Press, xyz_Temp, xy_SurfTemp, xyz_QH2OVap, xyz_QH2OLiq, xyz_QH2OSol, xyz_QO3, xyr_RadLFlux, xyra_DelRadLFlux )


    ! USE statements
    !

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    ! 時刻管理
    ! Time control
    !
    use timeset, only: TimeN, EndTime, TimesetClockStart, TimesetClockStop

    !
    ! Physical constants settings
    !
    use constants, only: PI, Grav     ! $ g $ [m s-2].
                                  !
                                  ! Gravitational acceleration

!!$    ! Chou et al (1991) による長波放射モデル
!!$    ! Long radiation model described by Chou et al (1991)
!!$    !
!!$    use radiation_C1991, only :               &
!!$      & RadiationC1991CalcTransMAH2O

    ! Chou and Kouvaris (1991) による長波放射モデル
    ! Long radiation model described by Chou and Kouvaris (1991)
    !
    use radiation_CK1991, only : RadiationCK1991CalcTrans

    ! Chou et al. (2001) による長波放射モデル
    ! Long radiation model described by Chou et al. (2001)
    !
    use radiation_C2001, only : RadiationC2001CalcTransBand3CO2, RadiationC2001CalcTransBand3H2O, RadiationC2001CalcTrans, RadiationC2001ReduceCloudOptDep, RadiationC2001CalcCloudOptProp , RadiationC2001CalcIntegratedPF2D, RadiationC2001CalcIntegratedPF3D

    ! 放射関連ルーチン
    ! Routines for radiation calculation
    !
    use radiation_utils, only : RadiationRTEQNonScat


    real(DP), intent(in ):: xyz_Press       (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_Temp        (0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(in ):: xy_SurfTemp     (0:imax-1, 1:jmax)
    real(DP), intent(in ):: xyz_QH2OVap     (0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(in ):: xyz_QH2OLiq     (0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(in ):: xyz_QH2OSol     (0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(in ):: xyz_QO3         (0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(out):: xyr_RadLFlux    (0:imax-1, 1:jmax, 0:kmax)
    real(DP), intent(out):: xyra_DelRadLFlux(0:imax-1, 1:jmax, 0:kmax, 0:1)


    !
    ! Work variables
    !
    real(DP) :: xy_SurfEmis       (0:imax-1, 1:jmax)
    real(DP) :: xyz_QCO2          (0:imax-1, 1:jmax, 1:kmax)

    real(DP) :: xyz_DelAtmMass    (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyz_DelCloudWat   (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyz_DelCloudIce   (0:imax-1, 1:jmax, 1:kmax)

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

    real(DP) :: xyz_CloudWatSSA      (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyz_CloudIceSSA      (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyz_CloudWatAF       (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyz_CloudIceAF       (0:imax-1, 1:jmax, 1:kmax)

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

    real(DP) :: xyz_TransCloudOneLayer (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xyrr_TransCloud        (0:imax-1, 1:jmax, 0:kmax, 0:kmax)
    real(DP) :: xyrr_CloudOverlapFactor(0:imax-1, 1:jmax, 0:kmax, 0:kmax)

    real(DP) :: xyrr_Trans            (0:imax-1, 1:jmax, 0:kmax, 0:kmax)
    real(DP) :: xyrr_TransEach        (0:imax-1, 1:jmax, 0:kmax, 0:kmax)
    real(DP) :: xyr_RadFlux           (0:imax-1, 1:jmax, 0:kmax)
    real(DP) :: xyra_DelRadFlux       (0:imax-1, 1:jmax, 0:kmax, 0:1)

    real(DP) :: xyz_IntPF   (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xy_SurfIntPF(0:imax-1, 1:jmax)
    real(DP) :: xy_IntDPFDT0(0:imax-1, 1:jmax)
    real(DP) :: xy_IntDPFDT1(0:imax-1, 1:jmax)


!!$    real(DP) :: xyr_RadFluxMA    (0:imax-1, 1:jmax, 0:kmax)
!!$    real(DP) :: xyra_DelRadFluxMA(0:imax-1, 1:jmax, 0:kmax, 0:1)

    real(DP) :: xyz_IntPF2   (0:imax-1, 1:jmax, 1:kmax)
    real(DP) :: xy_SurfIntPF2(0:imax-1, 1:jmax)
    real(DP) :: xy_IntDPFDT02(0:imax-1, 1:jmax)
    real(DP) :: xy_IntDPFDT12(0:imax-1, 1:jmax)
    integer :: i, j

    integer :: k
    integer :: kk
    integer :: n


    ! 計算時間計測開始
    ! Start measurement of computation time
    !
    call TimesetClockStart( module_name )


    if ( .not. radiation_dcpam_E_LW_V2_3_inited ) then
      call RadiationDcpamELWV23Init
    end if


    xyz_QCO2 = VMRCO2 * CO2MolWeight / MeanMolWeight


!!$    do k = 1, kmax
!!$      xyz_DelCloudWat(:,:,k) = xyz_QH2OLiq(:,:,k) &
!!$        & * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
!!$      xyz_DelCloudIce(:,:,k) = xyz_QH2OSol(:,:,k) &
!!$        & * ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k) ) / Grav
!!$    end do


    do k = 1, kmax
      xyz_DelAtmMass(:,:,k) = ( xyr_Press(:,:,k-1) - xyr_Press(:,:,k ) ) / Grav
    end do

    xyz_DelCloudWat = xyz_DelAtmMass * xyz_QH2OLiq
    xyz_DelCloudIce = xyz_DelAtmMass * xyz_QH2OSol



    if ( ( TimeN - PrevTimeSave >= IntTimeSave ) .or. ( .not. FlagTransSaved ) ) then

!!$      write( 6, * ) 'CalcTrans'

      if ( .not. FlagTransSaved ) then
        PrevTimeSave = TimeN
      else
        PrevTimeSave = PrevTimeSave + IntTimeSave
      end if

      FlagTransSaved = .true.


      LOOP_band_trans: do n = 1, nbmax

        xyrr_Trans = 1.0_DP

        if ( n == nbmax ) then

          ! Now, nothing is done when n = nbmax.

        else if ( n == 3 ) then
          ! 540-800 cm-1

          !   Calculation of H2O line and continuum transmittance
          call RadiationC2001CalcTransBand3H2O( xyz_Press, xyr_Press, xyz_Temp, xyz_QH2OVap, xyrr_TransEach )
          xyrr_Trans = xyrr_Trans * xyrr_TransEach
          !   Calculation of CO2 transmittance
          if ( FlagHighAlt ) then
            ! Transmittance calculation for middle atmospehre as well as lower atmosphere
            call RadiationCK1991CalcTrans( xyr_Press, xyz_Press, xyz_Temp, xyz_QCO2, 'CO2', xyrr_TransEach )
          else
            ! Transmittance calculation for lower atmoshere
            call RadiationC2001CalcTransBand3CO2( xyz_Press, xyr_Press, xyz_Temp, xyz_QCO2, xyrr_TransEach )
          end if
          xyrr_Trans = xyrr_Trans * xyrr_TransEach

        else

          !   Calculation of H2O continuum transmittance
          call RadiationC2001CalcTrans( 'H2OCont', n, xyz_Press, xyr_Press, xyz_Temp, xyz_QH2OVap, xyrr_TransEach )
          xyrr_Trans = xyrr_Trans * xyrr_TransEach
          !   Calculation of H2O line transmittance
          call RadiationC2001CalcTrans( 'H2OLine', n, xyz_Press, xyr_Press, xyz_Temp, xyz_QH2OVap, xyrr_TransEach )
          xyrr_Trans = xyrr_Trans * xyrr_TransEach

          if ( n == 5 ) then
            ! 980-1100 cm-1

            !   Calculation of O3 transmittance
            call RadiationCK1991CalcTrans( xyr_Press, xyz_Press, xyz_Temp, xyz_QO3, 'O3', xyrr_TransEach )
            xyrr_Trans = xyrr_Trans * xyrr_TransEach

          end if

        end if

        xyrra_TransSaved(:,:,:,:,n) = xyrr_Trans

      end do LOOP_band_trans

      !
      !   Calculation of transmittance of water vapor by using a method for middle 
      !   atmosphere
      !
!!$      call RadiationC1991CalcTransMAH2O(      &
!!$        & xyr_Press, xyz_Press, xyz_Temp, xyz_QH2OVap, & ! (in)
!!$        & xyrr_Trans                                & ! (out)
!!$        & )
      xyrr_Trans = -1.0d100

      xyrr_TransMASaved = xyrr_Trans

    end if


    !
    ! Calculate radiative flux
    !

    xy_SurfEmis      = 1.0_DP


    xyr_RadLFlux     = 0.0_DP
    xyra_DelRadLFlux = 0.0_DP


    LOOP_band_RTEQ: do n = 1, nbmax


      xyz_CloudREff = CloudWatREff
      call RadiationC2001CalcCloudOptProp( 'Liquid', n, xyz_CloudREff, xyz_CloudExtCoef, xyz_CloudWatSSA, xyz_CloudWatAF )
      xyz_DelCloudWatOptDep = xyz_CloudExtCoef * xyz_DelCloudWat
      !
      xyz_CloudREff = CloudIceREff
      call RadiationC2001CalcCloudOptProp( 'Ice', n, xyz_CloudREff, xyz_CloudExtCoef, xyz_CloudIceSSA, xyz_CloudIceAF )
      xyz_DelCloudIceOptDep = xyz_CloudExtCoef * xyz_DelCloudIce

!!$        call RadiationC2001ReduceCloudOptDep(      &
!!$          & xyz_CloudWatSSA, xyz_CloudWatAF,                             & ! (in)
!!$          & xyz_DelCloudOptDep                                & ! (inout)
!!$          & )
      !
      xyz_TransCloudOneLayer = exp( - ( xyz_DelCloudWatOptDep + xyz_DelCloudIceOptDep ) * DiffFactor )
      !
      do k = 0, kmax
        kk = k
        xyrr_TransCloud(:,:,k,kk) = 1.0d0
        do kk = k+1, kmax
          xyrr_TransCloud(:,:,k,kk) = xyrr_TransCloud(:,:,k,kk-1) * xyz_TransCloudOneLayer(:,:,kk)
        end do
      end do
      do k = 0, kmax
        do kk = 0, k-1
          xyrr_TransCloud(:,:,k,kk) = xyrr_TransCloud(:,:,kk,k)
        end do
      end do


      ! Now, nothing is done when n = nbmax.
      if ( n == nbmax ) cycle


      xyrr_Trans = xyrra_TransSaved(:,:,:,:,n)

      xyrr_Trans = xyrr_Trans * xyrr_TransCloud



      call CalcIntegratedPFWithTable2D( n, xy_SurfTemp, xy_SurfIntPF, 1, jmax )
      call CalcIntegratedPFWithTable3D( n, kmax, xyz_Temp, xyz_IntPF, 1, jmax )

      call CalcIntegratedPFWithTable2D( n, xy_SurfTemp, xy_IntDPFDT0, 1, jmax, .true. )
      call CalcIntegratedPFWithTable2D( n, xyz_Temp(:,:,1), xy_IntDPFDT1, 1, jmax, .true. )

      xy_SurfIntPF = xy_SurfEmis * PI * xy_SurfIntPF
      xyz_IntPF    =               PI * xyz_IntPF
      xy_IntDPFDT0 = xy_SurfEmis * PI * xy_IntDPFDT0
      xy_IntDPFDT1 =               PI * xy_IntDPFDT1



      ! Lines below are under testing.
      !
!!$      xy_SurfIntPF2 = xy_SurfIntPF
!!$      xyz_IntPF2    = xyz_IntPF
!!$      xy_IntDPFDT02 = xy_IntDPFDT0
!!$      xy_IntDPFDT12 = xy_IntDPFDT1
!!$
!!$
!!$      call RadiationC2001CalcIntegratedPF2D( &
!!$        & n, xy_SurfTemp,                    &
!!$        & xy_SurfIntPF                       &
!!$        & )
!!$      call RadiationC2001CalcIntegratedPF3D( &
!!$        & n, kmax, xyz_Temp,                 &
!!$        & xyz_IntPF                          &
!!$        & )
!!$
!!$      call RadiationC2001CalcIntegratedPF2D( &
!!$        & n, xy_SurfTemp,                    &
!!$        & xy_IntDPFDT0,                      &
!!$        & .true.                             &
!!$        & )
!!$      call RadiationC2001CalcIntegratedPF2D( &
!!$        & n, xyz_Temp(:,:,1),                &
!!$        & xy_IntDPFDT1,                      &
!!$        & .true.                             &
!!$        & )
!!$
!!$      xy_SurfIntPF = xy_SurfEmis * xy_SurfIntPF
!!$      xyz_IntPF    =               xyz_IntPF
!!$      xy_IntDPFDT0 = xy_SurfEmis * xy_IntDPFDT0
!!$      xy_IntDPFDT1 =               xy_IntDPFDT1
!!$
!!$      do j = 1, jmax
!!$        do i = 0, imax-1
!!$          write( 20+n, * ) xy_SurfTemp(i,j), xy_SurfIntPF2(i,j), xy_SurfIntPF(i,j), &
!!$            & xy_IntDPFDT02(i,j), xy_IntDPFDT02(i,j)
!!$        end do
!!$      end do
!!$      do j = 1, jmax
!!$        do i = 0, imax-1
!!$          write( 40+n, * ) xyz_Temp(i,j,1), xy_IntDPFDT12(i,j), xy_IntDPFDT12(i,j)
!!$        end do
!!$      end do
!!$      do k = 1, kmax
!!$        do j = 1, jmax
!!$          do i = 0, imax-1
!!$            write( 60+n, * ) xyz_Temp(i,j,k), xyz_IntPF2(i,j,k), xyz_IntPF(i,j,k)
!!$          end do
!!$        end do
!!$      end do
!!$      call flush( 20+n )
!!$      call flush( 40+n )
!!$      call flush( 60+n )



      call RadiationRTEQNonScat( xyz_IntPF, xy_SurfIntPF, xy_IntDPFDT1, xy_IntDPFDT0, xyrr_Trans, xyr_RadFlux, xyra_DelRadFlux )




!!$      if ( ( n == 1 ) .or. ( n == 2 ) .or. ( n == 9 ) ) then
!!$        !
!!$        ! For bands 0-340, 340-540, 1380-1900
!!$        ! merge with flux calculated with a method for middle atmosphere
!!$        !
!!$
!!$        xyrr_Trans = xyrr_TransMASaved
!!$
!!$        call RadiationELWV22IntegRTE(                         &
!!$          & n,                                                & ! (in )
!!$          & xyz_Temp, xy_SurfTemp, xy_SurfEmis, xyrr_Trans,   & ! (in )
!!$          & xyr_RadFluxMA, xyra_DelRadFluxMA                  & ! (out)
!!$          & )
!!$
!!$        call RadiationDcpamELWV22CutMergeFlux( &
!!$          & xyr_Press,                              & ! (in)
!!$          & xyr_RadFlux, xyra_DelRadFlux,         & ! (inout)
!!$          & xyr_RadFluxMA, xyra_DelRadFluxMA      & ! (in) optional
!!$          & )
!!$
!!$      else if ( ( n == 4 ) .or. ( n == 6 ) .or. ( n == 8 ) ) then
!!$        !
!!$        ! For bands 800-980, 1100-1380, 1900-3000
!!$        ! flux above a pressure level is modified to be constant
!!$        !
!!$
!!$        call RadiationDcpamELWV22CutMergeFlux( &
!!$          & xyr_Press,                              & ! (in)
!!$          & xyr_RadFlux, xyra_DelRadFlux          & ! (inout)
!!$          & )
!!$
!!$      end if


      xyr_RadLFlux     = xyr_RadLFlux     + xyr_RadFlux
      xyra_DelRadLFlux = xyra_DelRadLFlux + xyra_DelRadFlux

    end do LOOP_band_RTEQ





!!$    i = 0
!!$    j = jmax / 2 + 1
!!$    write( 73, * ) xy_SurfTemp(i,j), 0.0d0, 0.0d0, xyr_Press(i,j,0)
!!$    do k = 1, kmax
!!$      write( 73, * ) xyz_Temp(i,j,k), xyz_QH2OVap(i,j,k), xyz_QO3(i,j,k), &
!!$        & xyz_Press(i,j,k)
!!$    end do
!!$    call flush( 73 )
!!$
!!$    i = 0
!!$    j = jmax / 2 + 1
!!$    do k = 1, kmax
!!$      write( 83, * ) &
!!$        & + (     xyr_RadLFlux(i,j,k-1) - xyr_RadLFlux(i,j,k) )  &
!!$        &     / ( xyr_Press(i,j,k-1)    - xyr_Press(i,j,k) )     &
!!$        &     / 1004.6 * 9.8, &
!!$        & xyz_Press(i,j,k)
!!$    end do
!!$    call flush( 83 )
!!$
!!$    i = 0
!!$    j = jmax / 2 + 1
!!$    do k = 0, kmax
!!$      write( 93, * ) xyr_RadLFlux(i,j,k), xyr_Press(i,j,k)
!!$    end do
!!$    call flush( 93 )
!!$    stop



    ! 計算時間計測一時停止
    ! Pause measurement of computation time
    !
    call TimesetClockStop( module_name )

  end subroutine RadiationDcpamELWV23Flux

radiation_dcpam_E_LW_V2_3_inited

Variable :

radiation_dcpam_E_LW_V2_3_inited = .false. :

logical, save, public

:	初期設定フラグ. Initialization flag

Private Instance methods

CO2MolWeight

*Variable* :
`CO2MolWeight` :	`real(DP), save`

CalcIntegratedPFWithTable2D( iband, xy_IntegPF, js, je, [flag_DPFDT] )

*Subroutine* :
`iband` :	`integer , intent(in )`
`xy_IntegPF(0:imax-1, 1:jmax)` :	`real(DP), intent(out)`
`js` :	`integer , intent(in )`
`je` :	`integer , intent(in )`
`flag_DPFDT` :	`logical , intent(in ), optional`

[Source]

  subroutine CalcIntegratedPFWithTable2D( iband, xy_Temp, xy_IntegPF, js, je, flag_DPFDT )

    ! USE statements
    !

    integer , intent(in )           :: iband
    real(DP), intent(in )           :: xy_temp   (0:imax-1, 1:jmax)
    real(DP), intent(out)           :: xy_IntegPF(0:imax-1, 1:jmax)
    integer , intent(in )           :: js
    integer , intent(in )           :: je
    logical , intent(in ), optional :: flag_DPFDT

    !
    ! local variables
    !
    real(DP) :: xyz_Temp   (0:imax-1, 1:jmax, 1)
    real(DP) :: xyz_IntegPF(0:imax-1, 1:jmax, 1)
    integer  :: j


    do j = js, je
      xyz_Temp(:,j,1) = xy_Temp(:,j)
    end do

    call CalcIntegratedPFWithTable3D( iband, 1, xyz_temp, xyz_IntegPF, js, je, flag_DPFDT )

    do j = js, je
      xy_IntegPF(:,j) = xyz_IntegPF(:,j,1)
    end do


  end subroutine CalcIntegratedPFWithTable2D

CalcIntegratedPFWithTable3D( iband, km, xyz_temp, xyz_IntegPF, js, je, [flag_DPFDT] )

*Subroutine* :
`iband` :	`integer , intent(in )`
`km` :	`integer , intent(in )`
`xyz_temp(0:imax-1, 1:jmax, 1:km)` :	`real(DP), intent(in )`
`xyz_IntegPF(0:imax-1, 1:jmax, 1:km)` :	`real(DP), intent(out)`
`js` :	`integer , intent(in )`
`je` :	`integer , intent(in )`
`flag_DPFDT` :	`logical , intent(in ), optional`

[Source]

  subroutine CalcIntegratedPFWithTable3D( iband, km, xyz_temp, xyz_IntegPF, js, je, flag_DPFDT )

    ! USE statements
    !

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    integer , intent(in ) :: iband
    integer , intent(in ) :: km
    real(DP), intent(in ) :: xyz_temp   (0:imax-1, 1:jmax, 1:km)
    real(DP), intent(out) :: xyz_IntegPF(0:imax-1, 1:jmax, 1:km)
    logical , intent(in ), optional :: flag_DPFDT
    integer , intent(in )           :: js
    integer , intent(in )           :: je

    !
    ! local variables
    !
    logical                     :: local_flag_DPFDT

    integer                     :: xyz_TempIndex(0:imax-1, 1:jmax, 1:km)
    integer                     :: i
    integer                     :: j
    integer                     :: k
    integer                     :: m


    do k = 1, km
      do j = js, je
        do i = 0, imax-1

          if ( ( xyz_Temp(i,j,k) < a_TableTemp(1)     ) .or. ( xyz_Temp(i,j,k) > a_TableTemp(ntmax) ) ) then
            call MessageNotify( 'E', module_name, 'Temperature is not appropriate, Temp(%d,%d,%d) = %f.', i = (/i, j, k/), d = (/xyz_Temp(i,j,k)/) )
          end if

          xyz_TempIndex(i,j,k) = int( ( xyz_Temp(i,j,k) - TableTempMin ) / TableTempIncrement ) + 2

          if ( xyz_TempIndex(i,j,k) == 1 ) then
             xyz_TempIndex(i,j,k) = 2
          else if ( xyz_TempIndex(i,j,k) >= ntmax ) then
             xyz_TempIndex(i,j,k) = ntmax - 1
          end if

!!$          xyz_TempIndex(i,j,k) = ntmax-1
!!$          search_index: do m = 2, ntmax-1
!!$            if ( a_TableTemp(m) >= xyz_Temp(i,j,k) ) then
!!$              xyz_TempIndex(i,j,k) = m
!!$              exit search_index
!!$            end if
!!$          end do search_index

        end do
      end do
    end do


    local_flag_DPFDT = .false.
    if ( present( flag_DPFDT ) ) then
      if ( flag_DPFDT ) then
        local_flag_DPFDT = .true.
      end if
    end if

    if ( .not. local_flag_DPFDT ) then
      do k = 1, km
        do j = js, je
          do i = 0, imax-1
            m = xyz_TempIndex(i,j,k)

!!$            xyz_IntegPF(i,j,k) = &
!!$              &   ( aa_TableIPF( m, iband ) - aa_TableIPF( m-1, iband ) ) &
!!$              & / ( a_TableTemp( m )        - a_TableTemp( m-1 )        ) &
!!$              & * ( xyz_Temp(i,j,k)         - a_TableTemp( m-1 )        ) &
!!$              & +   aa_TableIPF( m-1, iband )

            xyz_IntegPF(i,j,k) = aa_TableIPF(m-1,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m   ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m+1 ) ) / ( ( a_TableTemp( m-1 ) - a_TableTemp( m   ) ) * ( a_TableTemp( m-1 ) - a_TableTemp( m+1 ) ) ) + aa_TableIPF(m  ,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m-1 ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m+1 ) ) / ( ( a_TableTemp( m   ) - a_TableTemp( m-1 ) ) * ( a_TableTemp( m   ) - a_TableTemp( m+1 ) ) ) + aa_TableIPF(m+1,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m-1 ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m   ) ) / ( ( a_TableTemp( m+1 ) - a_TableTemp( m-1 ) ) * ( a_TableTemp( m+1 ) - a_TableTemp( m   ) ) )
          end do
        end do
      end do
    else
      do k = 1, km
        do j = js, je
          do i = 0, imax-1
            m = xyz_TempIndex(i,j,k)

!!$            xyz_IntegPF(i,j,k) = &
!!$              &   ( aa_TableIDPFDT( m, iband ) - aa_TableIDPFDT( m-1, iband ) ) &
!!$              & / ( a_TableTemp   ( m )        - a_TableTemp   ( m-1 )        ) &
!!$              & * ( xyz_Temp(i,j,k)         - a_TableTemp( m-1 )        ) &
!!$              & +   aa_TableIDPFDT( m-1, iband )

            xyz_IntegPF(i,j,k) = aa_TableIDPFDT(m-1,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m   ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m+1 ) ) / ( ( a_TableTemp( m-1 ) - a_TableTemp( m   ) ) * ( a_TableTemp( m-1 ) - a_TableTemp( m+1 ) ) ) + aa_TableIDPFDT(m  ,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m-1 ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m+1 ) ) / ( ( a_TableTemp( m   ) - a_TableTemp( m-1 ) ) * ( a_TableTemp( m   ) - a_TableTemp( m+1 ) ) ) + aa_TableIDPFDT(m+1,iband) * ( xyz_Temp   (i,j,k) - a_TableTemp( m-1 ) ) * ( xyz_Temp   (i,j,k) - a_TableTemp( m   ) ) / ( ( a_TableTemp( m+1 ) - a_TableTemp( m-1 ) ) * ( a_TableTemp( m+1 ) - a_TableTemp( m   ) ) )
          end do
        end do
      end do
    end if


  end subroutine CalcIntegratedPFWithTable3D

CloudIceREff

*Variable* :
`CloudIceREff` :	`real(DP), save`

CloudWatREff

*Variable* :
`CloudWatREff` :	`real(DP), save`

DiffFactor

*Constant* :
`DiffFactor` `= 1.66d0` :	`real(DP), parameter`

FlagHighAlt

*Variable* :
`FlagHighAlt` :	`logical , save`

FlagTransSaved

*Variable* :
`FlagTransSaved` :	`logical , save`

H2OMolWeight

*Variable* :
`H2OMolWeight` :	`real(DP), save`

IntTimeSave

Variable :

IntTimeSave :

real(DP), save

:	長波フラックスを計算する時間間隔. Interval time of long wave flux calculation

MeanMolWeight

*Variable* :
`MeanMolWeight` :	`real(DP), save`

PrevTimeSave

Variable :

PrevTimeSave :

real(DP), save

:	前回長波フラックスを計算した時刻. Time when long wave flux is calculated

RadiationDcpamELWV23Init( )

Subroutine :

This procedure input/output NAMELIST#radiation_dcpam_E_LW_V2_3_nml .

[Source]

  subroutine RadiationDcpamELWV23Init

    ! USE statements
    !

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    ! ファイル入出力補助
    ! File I/O support
    !
    use dc_iounit, only: FileOpen

    ! NAMELIST ファイル入力に関するユーティリティ
    ! Utilities for NAMELIST file input
    !
    use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid

    ! 暦と日時の取り扱い
    ! Calendar and Date handler
    !
    use dc_calendar, only: DCCalConvertByUnit



    real(DP)          :: DelTimeCalcTransValue
    character(STRING) :: DelTimeCalcTransUnit

    integer:: unit_nml        ! NAMELIST ファイルオープン用装置番号.
                              ! Unit number for NAMELIST file open
    integer:: iostat_nml      ! NAMELIST 読み込み時の IOSTAT.
                              ! IOSTAT of NAMELIST read

    integer :: n


    namelist /radiation_dcpam_E_LW_V2_3_nml/ FlagHighAlt, CloudWatREff, CloudIceREff, VMRCO2, DelTimeCalcTransValue, DelTimeCalcTransUnit, flag_save_time


    if ( radiation_dcpam_E_LW_V2_3_inited ) return


    FlagHighAlt           = .false.

    CloudWatREff          = 10.0d-6
    CloudIceREff          = 10.0d-6

    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, namelist_filename, mode = 'r' ) ! (in)

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

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

    ! Handle interval time
    !
    IntTimeSave = DCCalConvertByUnit( DelTimeCalcTransValue, DelTimeCalcTransUnit, 'sec' ) ! (in)



    MeanMolWeight = 28.0d-3
    H2OMolWeight  = 18.0d-3
    CO2MolWeight  = 44.0d-3


    do n = 1, nbmax
      ! unit conversion from (cm-1) to (m-1)
      aa_BandParam(1,n) = aa_BandParam(1,n) * 1.0d2
      aa_BandParam(2,n) = aa_BandParam(2,n) * 1.0d2
    end do


    ! allocate a variable for saving transmittance
    !
    allocate( xyrra_TransSaved (0:imax-1,1:jmax,0:kmax,0:kmax,1:nbmax) )
    allocate( xyrr_TransMASaved(0:imax-1,1:jmax,0:kmax,0:kmax)         )


    call RadiationDcpamELWV23PrepPFTable


    ! 印字 ; Print
    !
    call MessageNotify( 'M', module_name, '----- Initialization Messages -----' )
    call MessageNotify( 'M', module_name, '  FlagHighAlt       = %b', l = (/ FlagHighAlt /) )
    call MessageNotify( 'M', module_name, '  CloudWatREff      = %f', d = (/ CloudWatREff /) )
    call MessageNotify( 'M', module_name, '  CloudIceREff      = %f', d = (/ CloudIceREff /) )
    call MessageNotify( 'M', module_name, '  VMRCO2            = %f', d = (/ VMRCO2 /) )
    call MessageNotify( 'M', module_name, '  DelTimeCalcTrans  = %f [%c]', d = (/ DelTimeCalcTransValue /), c1 = trim( DelTimeCalcTransUnit ) )
    call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) )


    radiation_dcpam_E_LW_V2_3_inited = .true.

  end subroutine RadiationDcpamELWV23Init

RadiationDcpamELWV23PrepPFTable( )

Subroutine :

[Source]

  subroutine RadiationDcpamELWV23PrepPFTable

    ! メッセージ出力
    ! Message output
    !
    use dc_message, only: MessageNotify

    ! ガウス重み, 分点の計算
    ! Calculate Gauss node and Gaussian weight
    !
    use gauss_quad, only : GauLeg

    ! プランク関数の計算
    ! Calculate Planck function
    !
    use planck_func, only : PF, DPFDT, Integ_PF_GQ_Array2D, Integ_DPFDT_GQ_Array2D

    integer , parameter :: NGaussQuad = 5
    logical             :: FlagCheckLoopExit
    real(DP)            :: xy_TempTMP   (0:imax-1, 1:jmax)
    real(DP)            :: xy_PF        (0:imax-1, 1:jmax)
    real(DP)            :: xy_DPFDT     (0:imax-1, 1:jmax)
    real(DP)            :: xy_PFTable   (0:imax-1, 1:jmax)
    real(DP)            :: xy_DPFDTTable(0:imax-1, 1:jmax)
    real(DP)            :: ErrorPFInteg
    real(DP), parameter :: ThresholdErrorPFInteg = 1.0d-3
                              ! Threshold for checking accuracy of calculation of
                              ! integrated Planc function by using a pre-calculated
                              ! table.

    ! Variables for preparation for calculation of Plank function
    !
    real(DP)      , allocatable :: GQP(:)
    real(DP)      , allocatable :: GQW(:)


    integer:: i
    integer:: j
    integer:: l
    integer:: m
    integer:: n


    ! Preparation of tables for calculation of Plank function
    !
    TableTempMin       =  50.0d0
    TableTempMax       = 600.0d0
    TableTempIncrement =   0.1d0
    ntmax              = ( TableTempMax - TableTempMin ) / TableTempIncrement + 1
    allocate( a_TableTemp   (1:ntmax) )
    allocate( aa_TableIPF   (1:ntmax, 1:nbmax) )
    allocate( aa_TableIDPFDT(1:ntmax, 1:nbmax) )

    do m = 1, ntmax
      a_TableTemp(m) = TableTempMin + TableTempIncrement * ( m - 1 )
    end do


    aa_TableIPF   (:,:) = 0.0d0
    aa_TableIDPFDT(:,:) = 0.0d0

    allocate( GQP(1:NGaussQuad) )
    allocate( GQW(1:NGaussQuad) )
    do n = 1, nbmax
      call GauLeg( aa_BandParam(1,n), aa_BandParam(2,n), NGaussQuad, GQP, GQW )
      do m = 1, ntmax
        do l = 1, NGaussQuad
          aa_TableIPF   (m,n) = aa_TableIPF   (m,n) + PF   ( GQP(l), a_TableTemp(m) ) * GQW(l)
          aa_TableIDPFDT(m,n) = aa_TableIDPFDT(m,n) + DPFDT( GQP(l), a_TableTemp(m) ) * GQW(l)
        end do
      end do
    end do
    deallocate( GQP )
    deallocate( GQW )


    !----------------------------------------------------
    ! Check accuracy of integration of Planc function by using a pre-calculated table.
    !

    !      This routine is called once here, to initialize a pre-calculated table.
    n = 1
    xy_TempTMP = 300.0d0
    call CalcIntegratedPFWithTable2D( n, xy_TempTMP, xy_PFTable, 1, jmax, .false. )

    do n = 1, nbmax

      FlagCheckLoopExit = .false.
      l = 1
      do

        do j = 1, jmax
          do i = 0, imax-1
            xy_TempTMP(i,j) = a_TableTemp(1) + ( a_TableTemp(2) - a_TableTemp(1) ) * 0.5d0 + ( a_TableTemp(2) - a_TableTemp(1) ) * ( imax * jmax * ( l - 1 ) + imax * ( j - 1 ) + i )
          end do
        end do

        do j = 1, jmax
          do i = 0, imax-1
            if ( xy_TempTMP(i,j) > a_TableTemp(ntmax) ) then
              xy_TempTMP(i,j) = a_TableTemp(ntmax)
              FlagCheckLoopExit = .true.
            end if
          end do
        end do


        call Integ_PF_GQ_Array2D( aa_BandParam(1,n), aa_BandParam(2,n), NGaussQuad, 0, imax-1, 1, jmax, xy_TempTMP, xy_PF )
        call Integ_DPFDT_GQ_Array2D( 0, imax-1, 1, jmax, aa_BandParam(1,n), aa_BandParam(2,n), NGaussQuad, xy_TempTMP, xy_DPFDT )

        call CalcIntegratedPFWithTable2D( n, xy_TempTMP, xy_PFTable, 1, jmax, .false. )
        call CalcIntegratedPFWithTable2D( n, xy_TempTMP, xy_DPFDTTable, 1, jmax, .true. )

        do j = 1, jmax
          do i = 0, imax-1
            ErrorPFInteg = abs( xy_PF   (i,j) - xy_PFTable   (i,j) ) / xy_PF   (i,j)
            if ( ErrorPFInteg > ThresholdErrorPFInteg ) then
              call MessageNotify( 'E', module_name, 'Error of integrated PF, %f, is greater than threshold, %f, in band %d.', d = (/ ErrorPFInteg, ThresholdErrorPFInteg /), i = (/n/) )
            end if
            ErrorPFInteg = abs( xy_DPFDT(i,j) - xy_DPFDTTable(i,j) ) / xy_DPFDT(i,j)
            if ( ErrorPFInteg > ThresholdErrorPFInteg ) then
              call MessageNotify( 'E', module_name, 'Error of integrated DPFDT, %f, is greater than threshold, %f, in band %d', d = (/ ErrorPFInteg, ThresholdErrorPFInteg /), i = (/n/) )
            end if
          end do
        end do

        if ( FlagCheckLoopExit ) exit
        l = l + 1
      end do

    end do

  end subroutine RadiationDcpamELWV23PrepPFTable

TableTempIncrement

*Variable* :
`TableTempIncrement` :	`real(DP), save`

TableTempMax

*Variable* :
`TableTempMax` :	`real(DP), save`

TableTempMin

*Variable* :
`TableTempMin` :	`real(DP), save`

VMRCO2

Variable :

VMRCO2 :

real(DP), save

:	Volume mixing ratio of CO2

a_TableTemp

*Variable* :
`a_TableTemp(:)` :	`real(DP), save, allocatable`

aa_BandParam

*Variable* :
`aa_BandParam(1:2, 1:nbmax)` :	`real(DP), save`

aa_TableIDPFDT

*Variable* :
`aa_TableIDPFDT(:,:)` :	`real(DP), save, allocatable`

aa_TableIPF

*Variable* :
`aa_TableIPF(:,:)` :	`real(DP), save, allocatable`

flag_save_time

*Variable* :
`flag_save_time` :	`logical , save`

module_name

Constant :

module_name = ‘radiation_dcpam_E_LW_V2_3‘ :

character(*), parameter

:	モジュールの名称. Module name

nbmax

*Constant* :
`nbmax` `= 10` :	`integer , parameter`

ntmax

*Variable* :
`ntmax` :	`integer , save`

version

Constant :

version = ’$Name: dcpam5-20110228-4 $’ // ’$Id: radiation_dcpam_E_LW_V2_3.f90,v 1.4 2011-02-28 10:06:22 yot Exp $’ :

character(*), parameter

:	モジュールのバージョン Module version

xyrr_TransMASaved

*Variable* :
`xyrr_TransMASaved(:,:,:,:)` :	`real(DP), allocatable, save`

xyrra_TransSaved

*Variable* :
`xyrra_TransSaved(:,:,:,:,:)` :	`real(DP), allocatable, save`