#include <misc.h>#include <params.h>module radae!------------------------------------------------------------------------------!! Description:!! Data and subroutines to calculate absorptivities and emissivity needed! for the LW radiation calculation.!! Public interfaces are: !! radaeini -------------- Initialization! initialize_radbuffer -- Initialize the 3D abs/emis arrays.! radabs ---------------- Compute absorptivities.! radems ---------------- Compute emissivity.! radtpl ---------------- Compute Temperatures and path lengths.!! Author:  B. Collins!! $Id: radae.F90,v 1.10.4.5 2002/05/02 21:11:33 rosinski Exp $!------------------------------------------------------------------------------  use precision  use ppgrid  use infnan  use constituents,   only: co2vmr  implicit none  save!-----------------------------------------------------------------------------! PUBLIC:: By default data and interfaces are private!-----------------------------------------------------------------------------  private  public radabs, radems, radtpl, radaeini, initialize_radbuffer ! Public interface routines  integer, public, parameter :: nbands = 2          ! Number of spectral bands!! Following data needed for restarts and in radclwmx!  real(r8), public, allocatable, target :: abstot_3d(:,:,:,:) ! Non-adjacent layer absorptivites  real(r8), public, allocatable, target :: absnxt_3d(:,:,:,:) ! Nearest layer absorptivities  real(r8), public, allocatable, target :: emstot_3d(:,:,:)   ! Total emissivity!-----------------------------------------------------------------------------! PRIVATE:: The rest of the data is private to this module.!-----------------------------------------------------------------------------  real(r8) :: p0    ! Standard pressure (dynes/cm**2)  real(r8) :: amd   ! Molecular weight of dry air (g/mol)  real(r8) :: amco2 ! Molecular weight of co2   (g/mol)  integer, parameter :: n_u = 25   ! Number of U in abs/emis tables  integer, parameter :: n_p = 10   ! Number of P in abs/emis tables  integer, parameter :: n_tp = 10  ! Number of T_p in abs/emis tables  integer, parameter :: n_te = 21  ! Number of T_e in abs/emis tables  integer, parameter :: n_rh = 7   ! Number of RH in abs/emis tables  real(r8):: ah2onw(n_p, n_tp, n_u, n_te, n_rh)   ! absorptivity (non-window)  real(r8):: eh2onw(n_p, n_tp, n_u, n_te, n_rh)   ! emissivity   (non-window)  real(r8):: ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! absorptivity (window, for adjacent layers)  real(r8):: cn_ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! continuum transmission for absorptivity (window)  real(r8):: cn_eh2ow(n_p, n_tp, n_u, n_te, n_rh)    ! continuum transmission for emissivity   (window)  real(r8):: ln_ah2ow(n_p, n_tp, n_u, n_te, n_rh)    ! line-only transmission for absorptivity (window)  real(r8):: ln_eh2ow(n_p, n_tp, n_u, n_te, n_rh)    ! line-only transmission for emissivity   (window)!! Constant coefficients for water vapor overlap with trace gases.! Reference: Ramanathan, V. and  P.Downey, 1986: A Nonisothermal!            Emissivity and Absorptivity Formulation for Water Vapor!            Journal of Geophysical Research, vol. 91., D8, pp 8649-8666!  real(r8):: coefh(2,4) = reshape(  &         (/ (/5.46557e+01,-7.30387e-02/), &            (/1.09311e+02,-1.46077e-01/), &            (/5.11479e+01,-6.82615e-02/), &            (/1.02296e+02,-1.36523e-01/) /), (/2,4/) )!  real(r8):: coefj(3,2) = reshape( &            (/ (/2.82096e-02,2.47836e-04,1.16904e-06/), &               (/9.27379e-02,8.04454e-04,6.88844e-06/) /), (/3,2/) )!  real(r8):: coefk(3,2) = reshape( &            (/ (/2.48852e-01,2.09667e-03,2.60377e-06/) , &               (/1.03594e+00,6.58620e-03,4.04456e-06/) /), (/3,2/) )  real(r8):: c16,c17,c26,c27,c28,c29,c30,c31!! Farwing correction constants for narrow-band emissivity model,! introduced to account for the deficiencies in narrow-band model! used to derive the emissivity; tuned with Arkings line-by-line! calculations.  Just used for water vapor overlap with trace gases.!  real(r8):: fwcoef      ! Farwing correction constant  real(r8):: fwc1,fwc2   ! Farwing correction constants   real(r8):: fc1         ! Farwing correction constant !! Collins/Hackney/Edwards (C/H/E) H2O parameterization!! Notation:! U   = integral (P/P_0 dW)  eq. 15 in Ramanathan/Downey 1986! P   = atmospheric pressure! P_0 = reference atmospheric pressure! W   = precipitable water path! T_e = emission temperature! T_p = path temperature! RH  = path relative humidity!! absorptivity/emissivity in window are fit using an expression:!!      a/e = f_a/e * {1.0 - ln_a/e * cn_a/e} !! absorptivity/emissivity in non-window are fit using:! !      a/e = f_a/e * a/e_norm!! where!      a/e = absorptivity/emissivity! a/e_norm = absorptivity/emissivity normalized to 1!    f_a/e = value of a/e as U->infinity = f(T_e) only!   cn_a/e = continuum transmission!   ln_a/e = line transmission!! spectral interval:!   1 = 0-800 cm^-1 and 1200-2200 cm^-1 (rotation and rotation-vibration)!   2 = 800-1200 cm^-1                  (window)!! The H2O saturation table spans 160K to 351K in 1K intervals).!  real(r8), parameter:: min_tp_h2o = 160.0        ! min T_p for pre-calculated abs/emis   real(r8), parameter:: max_tp_h2o = 349.999999   ! max T_p for pre-calculated abs/emis   integer, parameter :: ntemp = 192 ! Number of temperatures in H2O sat. table for Tp  real(r8) :: estblh2o(0:ntemp)       ! saturation vapor pressure for H2O for Tp rang  integer, parameter :: o_fa = 6   ! Degree+1 of poly of T_e for absorptivity as U->inf.  integer, parameter :: o_fe = 6   ! Degree+1 of poly of T_e for emissivity as U->inf.!-----------------------------------------------------------------------------! Data for f in C/H/E fit -- value of A and E as U->infinity!-----------------------------------------------------------------------------!! fa/fe coefficients for 2 bands (0-800 & 1200-2200, 800-1200 cm^-1)!! Coefficients of polynomial for f_a in T_e!  real(r8), parameter:: fat(o_fa,nbands) = reshape( (/ &       (/-1.06665373E-01,  2.90617375E-02, -2.70642049E-04,   &   ! 0-800&1200-2200 cm^-1          1.07595511E-06, -1.97419681E-09,  1.37763374E-12/), &   !   0-800&1200-2200 cm^-1       (/ 1.10666537E+00, -2.90617375E-02,  2.70642049E-04,   &   ! 800-1200 cm^-1         -1.07595511E-06,  1.97419681E-09, -1.37763374E-12/) /) & !   800-1200 cm^-1       , (/o_fa,nbands/) )!! Coefficients of polynomial for f_e in T_e!  real(r8), parameter:: fet(o_fe,nbands) = reshape( (/ &       (/3.46148163E-01,  1.51240299E-02, -1.21846479E-04,   &   ! 0-800&1200-2200 cm^-1        4.04970123E-07, -6.15368936E-10,  3.52415071E-13/), &   !   0-800&1200-2200 cm^-1      (/6.53851837E-01, -1.51240299E-02,  1.21846479E-04,   &   ! 800-1200 cm^-1       -4.04970123E-07,  6.15368936E-10, -3.52415071E-13/) /) & !   800-1200 cm^-1      , (/o_fa,nbands/) )!! Note: max values should be slightly underestimated to avoid index bound violations!  real(r8), parameter:: min_lp_h2o = -3.0         ! min log_10(P) for pre-calculated abs/emis   real(r8), parameter:: min_p_h2o = 1.0e-3        ! min log_10(P) for pre-calculated abs/emis   real(r8), parameter:: max_lp_h2o = -0.0000001   ! max log_10(P) for pre-calculated abs/emis   real(r8), parameter:: dlp_h2o = 0.3333333333333 ! difference in adjacent elements of lp_h2o   real(r8), parameter:: dtp_h2o = 21.111111111111 ! difference in adjacent elements of tp_h2o  real(r8), parameter:: min_rh_h2o = 0.0          ! min RH for pre-calculated abs/emis   real(r8), parameter:: max_rh_h2o = 1.19999999   ! max RH for pre-calculated abs/emis   real(r8), parameter:: drh_h2o = 0.2             ! difference in adjacent elements of RH  real(r8), parameter:: min_te_h2o = -120.0       ! min T_e-T_p for pre-calculated abs/emis   real(r8), parameter:: max_te_h2o = 79.999999    ! max T_e-T_p for pre-calculated abs/emis   real(r8), parameter:: dte_h2o  = 10.0           ! difference in adjacent elements of te_h2o  real(r8), parameter:: min_lu_h2o = -8.0         ! min log_10(U) for pre-calculated abs/emis   real(r8), parameter:: min_u_h2o  = 1.0e-8       ! min pressure-weighted path-length  real(r8), parameter:: max_lu_h2o =  3.9999999   ! max log_10(U) for pre-calculated abs/emis   real(r8), parameter:: dlu_h2o  = 0.5            ! difference in adjacent elements of lu_h2o!-----------------------------------------------------------------------------! Public Interfaces!-----------------------------------------------------------------------------CONTAINSsubroutine radabs(lchnk   ,ncol    ,             &   pbr    ,pnm     ,co2em    ,co2eml  ,tplnka  , &   s2c    ,tcg     ,w        ,h2otr   ,plco2   , &   plh2o  ,co2t    ,tint     ,tlayr   ,plol    , &   plos   ,pmln    ,piln     ,ucfc11  ,ucfc12  , &   un2o0  ,un2o1   ,uch4     ,uco211  ,uco212  , &   uco213 ,uco221  ,uco222   ,uco223  ,uptype  , &   bn2o0  ,bn2o1   ,bch4    ,abplnk1  ,abplnk2 , &   abstot ,absnxt  ,plh2ob  ,wb       )!----------------------------------------------------------------------- ! ! Purpose: ! Compute absorptivities for h2o, co2, o3, ch4, n2o, cfc11 and cfc12! ! Method: ! h2o  ....  Uses nonisothermal emissivity method for water vapor from!            Ramanathan, V. and  P.Downey, 1986: A Nonisothermal!            Emissivity and Absorptivity Formulation for Water Vapor!            Journal of Geophysical Research, vol. 91., D8, pp 8649-8666!!            Implementation updated by Collins, Hackney, and Edwards (2001)!               using line-by-line calculations based upon Hitran 1996 and!               CKD 2.1 for absorptivity and emissivity!! co2  ....  Uses absorptance parameterization of the 15 micro-meter!            (500 - 800 cm-1) band system of Carbon Dioxide, from!            Kiehl, J.T. and B.P.Briegleb, 1991: A New Parameterization!            of the Absorptance Due to the 15 micro-meter Band System!            of Carbon Dioxide Jouranl of Geophysical Research,!            vol. 96., D5, pp 9013-9019.!            Parameterizations for the 9.4 and 10.4 mircon bands of CO2!            are also included.!! o3   ....  Uses absorptance parameterization of the 9.6 micro-meter!            band system of ozone, from Ramanathan, V. and R.Dickinson,!            1979: The Role of stratospheric ozone in the zonal and!            seasonal radiative energy balance of the earth-troposphere!            system. Journal of the Atmospheric Sciences, Vol. 36,!            pp 1084-1104!! ch4  ....  Uses a broad band model for the 7.7 micron band of methane.!! n20  ....  Uses a broad band model for the 7.8, 8.6 and 17.0 micron!            bands of nitrous oxide!! cfc11 ...  Uses a quasi-linear model for the 9.2, 10.7, 11.8 and 12.5!            micron bands of CFC11!! cfc12 ...  Uses a quasi-linear model for the 8.6, 9.1, 10.8 and 11.2!            micron bands of CFC12!!! Computes individual absorptivities for non-adjacent layers, accounting! for band overlap, and sums to obtain the total; then, computes the! nearest layer contribution.! ! Author: W. Collins (H2O absorptivity) and J. Kiehl! !-----------------------------------------------------------------------#include <crdcon.h>!------------------------------Arguments--------------------------------!! Input arguments!   integer, intent(in) :: lchnk                       ! chunk identifier   integer, intent(in) :: ncol                        ! number of atmospheric columns   real(r8), intent(in) :: pbr(pcols,pver)            ! Prssr at mid-levels (dynes/cm2)   real(r8), intent(in) :: pnm(pcols,pverp)           ! Prssr at interfaces (dynes/cm2)   real(r8), intent(in) :: co2em(pcols,pverp)         ! Co2 emissivity function   real(r8), intent(in) :: co2eml(pcols,pver)         ! Co2 emissivity function   real(r8), intent(in) :: tplnka(pcols,pverp)        ! Planck fnctn level temperature   real(r8), intent(in) :: s2c(pcols,pverp)           ! H2o continuum path length   real(r8), intent(in) :: tcg(pcols,pverp)           ! H2o-mass-wgted temp. (Curtis-Godson approx.)   real(r8), intent(in) :: w(pcols,pverp)             ! H2o prs wghted path   real(r8), intent(in) :: h2otr(pcols,pverp)         ! H2o trnsmssn fnct for o3 overlap   real(r8), intent(in) :: plco2(pcols,pverp)         ! Co2 prs wghted path length   real(r8), intent(in) :: plh2o(pcols,pverp)         ! H2o prs wfhted path length   real(r8), intent(in) :: co2t(pcols,pverp)          ! Tmp and prs wghted path length   real(r8), intent(in) :: tint(pcols,pverp)          ! Interface temperatures   real(r8), intent(in) :: tlayr(pcols,pverp)         ! K-1 level temperatures   real(r8), intent(in) :: plol(pcols,pverp)          ! Ozone prs wghted path length   real(r8), intent(in) :: plos(pcols,pverp)          ! Ozone path length   real(r8), intent(in) :: pmln(pcols,pver)           ! Ln(pmidm1)   real(r8), intent(in) :: piln(pcols,pverp)          ! Ln(pintm1)   real(r8), intent(in) :: plh2ob(nbands,pcols,pverp) ! Pressure weighted h2o path with                                                       !    Hulst-Curtis-Godson temp. factor                                                       !    for H2O bands    real(r8), intent(in) :: wb(nbands,pcols,pverp)     ! H2o path length with                                                       !    Hulst-Curtis-Godson temp. factor                                                       !    for H2O bands !! Trace gas variables!   real(r8), intent(in) :: ucfc11(pcols,pverp)        ! CFC11 path length   real(r8), intent(in) :: ucfc12(pcols,pverp)        ! CFC12 path length   real(r8), intent(in) :: un2o0(pcols,pverp)         ! N2O path length   real(r8), intent(in) :: un2o1(pcols,pverp)         ! N2O path length (hot band)   real(r8), intent(in) :: uch4(pcols,pverp)          ! CH4 path length   real(r8), intent(in) :: uco211(pcols,pverp)        ! CO2 9.4 micron band path length   real(r8), intent(in) :: uco212(pcols,pverp)        ! CO2 9.4 micron band path length   real(r8), intent(in) :: uco213(pcols,pverp)        ! CO2 9.4 micron band path length