radctl.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <params.h>

subroutine radctl(lchnk   ,ncol    ,                   &
                  lwup    ,emis    ,          &
                  pmid    ,pint    ,pmln    ,piln    ,t       , &
                  qm1     ,cld     ,clwp    ,coszrs  ,          &
                  asdir   ,asdif   ,aldir   ,aldif   ,pmxrgn  , &
                  nmxrgn  ,fsns    ,fsnt    ,flns    ,flnt    , &
                  qrs     ,qrl     ,flwds   ,rel     ,rei     , &
                  fice    ,sols    ,soll    ,solsd   ,solld   , &
                  landfrac,zm      )
!----------------------------------------------------------------------- 
! 
! Purpose: 
! Driver for radiation computation.
! 
! Method: 
! Radiation uses cgs units, so conversions must be done from
! model fields to radiation fields.
!
! Author: CCM1,  CMS Contact: J. Truesdale
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid
   use pspect
   use so4bnd
   use commap
   use history, only: outfld
   use tracers,      only: ixcldw
   use constituents, only: ppcnst, cnst_get_ind
   use physconst, only: cpair

   implicit none

#include <ptrrgrid.h>
#include <comctl.h>
#include <comsol.h>
!
! Input arguments
!
   integer, intent(in) :: lchnk                 ! chunk identifier
   integer, intent(in) :: ncol                  ! number of atmospheric columns

   real(r8), intent(in) :: lwup(pcols)          ! Longwave up flux at surface
   real(r8), intent(in) :: emis(pcols,pver)     ! Cloud emissivity
   real(r8), intent(in) :: pmid(pcols,pver)     ! Model level pressures
   real(r8), intent(in) :: pint(pcols,pverp)    ! Model interface pressures
   real(r8), intent(in) :: pmln(pcols,pver)     ! Natural log of pmid
   real(r8), intent(in) :: rel(pcols,pver)      ! liquid effective drop size (microns)
   real(r8), intent(in) :: rei(pcols,pver)      ! ice effective drop size (microns)
   real(r8), intent(in) :: fice(pcols,pver)     ! fractional ice content within cloud
   real(r8), intent(in) :: piln(pcols,pverp)    ! Natural log of pint
   real(r8), intent(in) :: t(pcols,pver)        ! Model level temperatures
   real(r8), intent(in) :: qm1(pcols,pver,ppcnst) ! Specific humidity and tracers
   real(r8), intent(in) :: cld(pcols,pver)      ! Fractional cloud cover
   real(r8), intent(in) :: clwp(pcols,pver)     ! Cloud liquid water path
   real(r8), intent(in) :: coszrs(pcols)        ! Cosine solar zenith angle
   real(r8), intent(in) :: asdir(pcols)         ! albedo shortwave direct
   real(r8), intent(in) :: asdif(pcols)         ! albedo shortwave diffuse
   real(r8), intent(in) :: aldir(pcols)         ! albedo longwave direct
   real(r8), intent(in) :: aldif(pcols)         ! albedo longwave diffuse
   real(r8), intent(in) :: landfrac(pcols)      ! land fraction
   real(r8), intent(in) :: zm(pcols,pver)       ! Height of midpoints (above surface)
   real(r8), intent(inout) :: pmxrgn(pcols,pverp) ! Maximum values of pmid for each
!    maximally overlapped region.
!    0->pmxrgn(i,1) is range of pmid for
!    1st region, pmxrgn(i,1)->pmxrgn(i,2) for
!    2nd region, etc
   integer, intent(inout) :: nmxrgn(pcols)     ! Number of maximally overlapped regions
!
! Output solar arguments
!
   real(r8), intent(out) :: fsns(pcols)          ! Surface absorbed solar flux
   real(r8), intent(out) :: fsnt(pcols)          ! Net column abs solar flux at model top
   real(r8), intent(out) :: flns(pcols)          ! Srf longwave cooling (up-down) flux
   real(r8), intent(out) :: flnt(pcols)          ! Net outgoing lw flux at model top
   real(r8), intent(out) :: sols(pcols)          ! Downward solar rad onto surface (sw direct)
   real(r8), intent(out) :: soll(pcols)          ! Downward solar rad onto surface (lw direct)
   real(r8), intent(out) :: solsd(pcols)         ! Downward solar rad onto surface (sw diffuse)
   real(r8), intent(out) :: solld(pcols)         ! Downward solar rad onto surface (lw diffuse)
   real(r8), intent(out) :: qrs(pcols,pver)      ! Solar heating rate
!
! Output longwave arguments
!
   real(r8), intent(out) :: qrl(pcols,pver)      ! Longwave cooling rate
   real(r8), intent(out) :: flwds(pcols)         ! Surface down longwave flux


!
!---------------------------Local variables-----------------------------
!
   integer i, k              ! index

   integer :: in2o, ich4, if11, if12 ! indexes of gases in constituent array

   real(r8) solin(pcols)         ! Solar incident flux
   real(r8) fsds(pcols)          ! Flux Shortwave Downwelling Surface
   real(r8) fsntoa(pcols)        ! Net solar flux at TOA
   real(r8) fsntoac(pcols)       ! Clear sky net solar flux at TOA
   real(r8) fsnirt(pcols)        ! Near-IR flux absorbed at toa
   real(r8) fsnrtc(pcols)        ! Clear sky near-IR flux absorbed at toa
   real(r8) fsnirtsq(pcols)      ! Near-IR flux absorbed at toa >= 0.7 microns
   real(r8) fsntc(pcols)         ! Clear sky total column abs solar flux
   real(r8) fsnsc(pcols)         ! Clear sky surface abs solar flux
   real(r8) fsdsc(pcols)         ! Clear sky surface downwelling solar flux
   real(r8) flut(pcols)          ! Upward flux at top of model
   real(r8) lwcf(pcols)          ! longwave cloud forcing
   real(r8) swcf(pcols)          ! shortwave cloud forcing
   real(r8) flutc(pcols)         ! Upward Clear Sky flux at top of model
   real(r8) flntc(pcols)         ! Clear sky lw flux at model top
   real(r8) flnsc(pcols)         ! Clear sky lw flux at srf (up-down)
   real(r8) pbr(pcols,pverr)     ! Model mid-level pressures (dynes/cm2)
   real(r8) pnm(pcols,pverrp)    ! Model interface pressures (dynes/cm2)
   real(r8) o3vmr(pcols,pverr)   ! Ozone volume mixing ratio
   real(r8) o3mmr(pcols,pverr)   ! Ozone mass mixing ratio
   real(r8) eccf                 ! Earth/sun distance factor
   real(r8) n2o(pcols,pver)      ! nitrous oxide mass mixing ratio
   real(r8) ch4(pcols,pver)      ! methane mass mixing ratio
   real(r8) cfc11(pcols,pver)    ! cfc11 mass mixing ratio
   real(r8) cfc12(pcols,pver)    ! cfc12 mass mixing ratio
   real(r8) aermmr(pcols,pverr)  ! level aerosol mass mixing ratio
   real(r8) rh(pcols,pverr)      ! level relative humidity (fraction)
   real(r8) lwupcgs(pcols)       ! Upward longwave flux in cgs units

!
! Declare local arrays to which model input arrays are interpolated here.
! Current default is none since radiation grid = model grid.
!
! Declare variables used for indirect forcing calculations:
!
! ++ tls --------------------------------------------------------------2
   real(r8) locrhoair(pcols,pver)  ! dry air density            [kg/m^3 ]
   real(r8) lwcwat(pcols,pver)     ! in-cloud liquid water path [kg/m^3 ]
   real(r8) sulfbio(pcols,pver)    ! biogenic sulfate mmr       [kg/kg  ]
   real(r8) sulfant(pcols,pver)    ! anthropogenic sulfate mmr  [kg/kg  ]
   real(r8) sulfscalef             ! sulfate scale factor
   real(r8) sulfmix(pcols,pver)    ! sulfate mass mixing ratio  [kg/kg  ]
   real(r8) so4mass(pcols,pver)    ! sulfate mass concentration [g/cm^3 ]
   real(r8) Aso4(pcols,pver)       ! sulfate # concentration    [#/cm^3 ]
   real(r8) Ntot(pcols,pver)       ! ccn # concentration        [#/cm^3 ]
   real(r8) relmod(pcols,pver)     ! effective radius           [microns]

   real(r8) wrel(pcols,pver)       ! weighted effective radius    [microns]
   real(r8) wlwc(pcols,pver)       ! weighted liq. water content  [kg/m^3 ]
   real(r8) cldfrq(pcols,pver)     ! frequency of occurance of...
!                                  ! clouds (cld => 0.01)         [fraction]
   real(r8) ftem(pcols,pver)       ! temporary array for outfld

   real(r8) locPi                  ! my piece of the pi
   real(r8) Rdryair                ! gas constant of dry air   [J/deg/kg]
   real(r8) rhowat                 ! density of water          [kg/m^3  ]
   real(r8) Acoef                  ! m->A conversion factor; assumes
!                                  ! Dbar=0.10, sigma=2.0      [g^-1    ]
   real(r8) rekappa                ! kappa in evaluation of re(lmod)
   real(r8) recoef                 ! temp. coeficient for calc of re(lmod)
   real(r8) reexp                  ! 1.0/3.0
   real(r8) Ntotb                  ! temp var to hold below cloud ccn
! -- Parameters for background CDNC (from `ambient' non-sulfate aerosols)...
   real(r8) Cmarn                  ! Coef for CDNC_marine         [cm^-3]
   real(r8) Cland                  ! Coef for CDNC_land           [cm^-3]
   real(r8) Hmarn                  ! Scale height for CDNC_marine [m]
   real(r8) Hland                  ! Scale height for CDNC_land   [m]
   parameter ( Cmarn = 50.0, Cland = 100.0 )
   parameter ( Hmarn = 1000.0, Hland = 2000.0 )
   real(r8) bgaer                  ! temp var to hold background CDNC
!
! Statement functions
!
   logical land
   land(i) = nint(landfrac(i)).gt.0.5_r8
!
! -- tls --------------------------------------------------------------2
!
!--------------------------------------------------------------------------
!
! Interpolate ozone volume mixing ratio to model levels
!
   call radozn(lchnk   ,ncol    ,pmid    ,o3vmr   )
   call outfld('O3VMR   ',o3vmr ,pcols, lchnk)
!
! Set chunk dependent radiation input
!
   call radinp(lchnk   ,ncol    ,                                &
               pmid    ,pint    ,o3vmr   , pbr     ,&
               pnm     ,eccf    ,o3mmr   )
!
! Solar radiation computation
!
   if (dosw) then
! ++ tls ---------------------------------------------------------------2
!     write(6,*) 'Sulfate Scale Factor = ', sulfscalef

      locPi = 3.141592654
      Rdryair = 287.04
      rhowat = 1000.0
      Acoef = 1.2930E14
      recoef = 3.0/(4.0*locPi*rhowat)
      reexp = 1.0/3.0
!
      if ( doRamp_so4 ) then
         call getso4bnd( lchnk, ncol, sulfbio, sulfant )
         sulfscalef = so4ramp()
         do k = 1, pver
            do i = 1, ncol
               sulfmix(i,k) = sulfbio(i,k) + sulfscalef*sulfant(i,k)
            end do
         end do
         call outfld('SULFBIO ',sulfbio,pcols,lchnk)
         call outfld('SULFANT ',sulfant,pcols,lchnk)
         call outfld('SULFMMR ',sulfmix,pcols,lchnk)