#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)