#include <misc.h> #include <params.h> subroutine radctl(hbuf ,clat ,coslat ,lat ,lwup , 1,27 $ pmid ,pint ,pmln ,piln ,t , $ qm1 ,cld ,effcld ,clwp ,coszrs , $ asdir ,asdif ,aldir ,aldif ,fsns , $ qrs ,qrl ,flwds ,rel ,rei , $ fice ,sols ,soll ,solsd ,solld c++csz $ ,fsnt,fsntc,fsnsc,flnt,flns,flntc,flnsc,solin, ! Output $ fsnirt,fsnirtsq,fsnrtc, ! Output $ eccf, ! Output $ o3vmr) ! Input c--csz C----------------------------------------------------------------------- C C Driver for radiation computation. C C Radiation uses cgs units, so conversions must be done from C model fields to radiation fields. C C Calling sequence: C C radinp Converts units of model fields and computes ozone C mixing ratio for solar scheme C C radcsw Performs solar computation C radalb Computes surface albedos C radded Computes delta-Eddington solution C radclr Computes diagnostic clear sky fluxes C C radclw Performs longwave computation C C radtpl Computes path quantities C radems Computes emissivity C radabs Computes absorptivity C C---------------------------Code history-------------------------------- C C Original version: CCM1 C Standardized: J. Rosinski, June 1992 C Reviewed: J. Kiehl, B. Briegleb, August 1992 C C Modified: B. Briegleb, March 1995 to add aerosol C to shortwave code C C Reviewed: J. Kiehl, April 1996 C Reviewed: B. Briegleb, May 1996 C C----------------------------------------------------------------------- c c $Id: radctl.F,v 1.1.18.2 1999/09/07 19:01:35 zender Exp $ c #include <implicit.h> C------------------------------Parameters------------------------------- #include <pmgrid.h> #include <ptrrgrid.h> #include <pagrid.h> C------------------------------Commons---------------------------------- #include <comhst.h> C----------------------------------------------------------------------- #include <comtim.h> C----------------------------------------------------------------------- #include <comctl.h> C----------------------------------------------------------------------- #include <comsol.h> C----------------------------------------------------------------------- #include <comindx.h> C------------------------------Arguments-------------------------------- C C Input arguments C real hbuf(*) ! history tape buffer,for calls to outfld integer lat ! Latitude row index real lwup(plond) ! Longwave up flux at surface real pmid(plond,plev) ! Model level pressures real pint(plond,plevp) ! Model interface pressures real pmln(plond,plev) ! Natural log of pmid real rel(plond,plev) ! liquid effective drop size (microns) real rei(plond,plev) ! ice effective drop size (microns) real fice(plond,plev) ! fractional ice content within cloud real piln(plond,plevp) ! Natural log of pint real t(plond,plev) ! Model level temperatures real qm1(plond,plev,pcnst+pnats) ! Specific humidity and tracers real cld(plond,plevp) ! Fractional cloud cover real effcld(plond,plevp) ! Effective fractional cloud cover real clwp(plond,plev) ! Cloud liquid water path real coszrs(plond) ! Cosine solar zenith angle real asdir(plond) ! albedo shortwave direct real asdif(plond) ! albedo shortwave diffuse real aldir(plond) ! albedo longwave direct real aldif(plond) ! albedo longwave diffuse real clat ! current latitude(radians) real coslat ! cosine latitude C C Output solar arguments C real fsns(plond) ! Surface absorbed solar flux real sols(plond) ! Downward solar rad onto surface (sw direct) real soll(plond) ! Downward solar rad onto surface (lw direct) real solsd(plond) ! Downward solar rad onto surface (sw diffuse) real solld(plond) ! Downward solar rad onto surface (lw diffuse) real qrs(plond,plev) ! Solar heating rate C C Output longwave arguments C real qrl(plond,plev) ! Longwave cooling rate real flwds(plond) ! Surface down longwave flux C C---------------------------Local variables----------------------------- C integer i ! index real solin(plond) ! Solar incident flux real fsds(plond) ! Flux Shortwave Downwelling Surface real fsnirt(plond) ! Near-IR flux absorbed at toa real fsnrtc(plond) ! Clear sky near-IR flux absorbed at toa real fsnirtsq(plond) ! Near-IR flux absorbed at toa >= 0.7 microns real fsnt(plond) ! Net column abs solar flux at model top real fsntc(plond) ! Clear sky total column abs solar flux real fsnsc(plond) ! Clear sky surface abs solar flux real flnt(plond) ! Net outgoing lw flux at model top real flns(plond) ! Srf longwave cooling (up-down) flux real flntc(plond) ! Clear sky lw flux at model top real flnsc(plond) ! Clear sky lw flux at srf (up-down) real pbr(plond,plevr) ! Model mid-level pressures (dynes/cm2) real pnm(plond,plevrp) ! Model interface pressures (dynes/cm2) real o3vmr(plond,plevr) ! Ozone volume mixing ratio real o3mmr(plond,plevr) ! Ozone mass mixing ratio real plco2(plond,plevrp) ! Prs weighted CO2 path real plh2o(plond,plevrp) ! Prs weighted H2O path real tclrsf(plond,plevrp) ! Total clear sky fraction level to space real eccf ! Earth/sun distance factor real n2o(plond,plev) ! nitrous oxide mass mixing ratio real ch4(plond,plev) ! methane mass mixing ratio real cfc11(plond,plev) ! cfc11 mass mixing ratio real cfc12(plond,plev) ! cfc12 mass mixing ratio real aermmr(plond,plevr) ! level aerosol mass mixing ratio real rh(plond,plevr) ! level relative humidity (fraction) real lwupcgs(plond) ! Upward longwave flux in cgs units C C Declare local arrays to which model input arrays are interpolated here. C Current default is none since radiation grid = model grid. C C-------------------------------------------------------------------------- C C Interpolate model input arrays to radiation vertical grid. Currently this C is a do-nothing routine because radiation grid = model grid. C call torgrid(pmid ,pint ,pmln ,piln ,t , $ qm1(1,1,1),cld ,effcld ,clwp , $ pmid ,pint ,pmln ,piln ,t , $ qm1(1,1,1) ,cld ,effcld ,clwp ) C C Interpolate ozone volume mixing ratio to model levels C c++csz c radozn() is a do nothing routine in the CRM. c Instead of interpolating the o3vmr from the time-interpolated values, c we read specified o3vmr in getdat() and pass it directly into radctl(). c o3mmr is computed in radinp(). c--csz call radozn(lat ,pmid ,o3vmr ) call outfld('O3VMR ',o3vmr ,plond, lat, hbuf) C C Set latitude dependent radiation input C call radinp(pmid ,pint ,qm1(1,1,1) ,cld ,o3vmr , $ pbr ,pnm ,plco2 ,plh2o ,tclrsf , $ eccf ,o3mmr ) C C Solar radiation computation C if (dosw) then C C Specify aerosol mass mixing ratio C call aermix(pnm ,aermmr ,rh ) call radcsw(pnm ,qm1(1,1,1) ,o3mmr,aermmr ,rh , $ cld ,clwp ,rel ,rei ,fice , $ eccf ,coszrs ,asdir ,asdif ,aldir , $ aldif ,solin ,qrs ,fsns ,fsnt , $ fsds ,fsnsc ,fsntc ,sols ,soll , $ solsd ,solld ,fsnirt ,fsnrtc ,fsnirtsq, $ scon) C C Convert units of shortwave fields needed by rest of model from CGS to MKS C do i=1,plon solin(i) = solin(i)*1.e-3 fsds(i) = fsds(i)*1.e-3 fsnirt(i)= fsnirt(i)*1.e-3 fsnrtc(i)= fsnrtc(i)*1.e-3 fsnirtsq(i)= fsnirtsq(i)*1.e-3 fsnt(i) = fsnt(i) *1.e-3 fsns(i) = fsns(i) *1.e-3 fsntc(i) = fsntc(i)*1.e-3 fsnsc(i) = fsnsc(i)*1.e-3 end do C C Dump shortwave radiation information to history tape buffer (diagnostics) C call outfld('SOLIN ',solin ,plond,lat,hbuf) call outfld('FSDS ',fsds ,plond,lat,hbuf) call outfld('FSNIRT ',fsnirt,plond,lat,hbuf) call outfld('FSNRTC ',fsnrtc,plond,lat,hbuf) call outfld('FSNIRTSQ',fsnirtsq,plond,lat,hbuf) call outfld('FSNT ',fsnt ,plond,lat,hbuf) call outfld('FSNS ',fsns ,plond,lat,hbuf) call outfld('FSNTC ',fsntc ,plond,lat,hbuf) call outfld('FSNSC ',fsnsc ,plond,lat,hbuf) call outfld('SOLS ',sols ,plond,lat,hbuf) call outfld('SOLL ',soll ,plond,lat,hbuf) call outfld('SOLSD ',solsd ,plond,lat,hbuf) call outfld('SOLLD ',solld ,plond,lat,hbuf) end if C C Longwave radiation computation C if (dolw) then c c Convert upward longwave flux units to CGS c do i=1,plon lwupcgs(i) = lwup(i)*1000. end do c c Do longwave computation. If not implementing greenhouse gas code then C first specify trace gas mixing ratios. If greenhouse gas code then: C o ixtrcg => indx of advected n2o tracer C o ixtrcg+1 => indx of advected ch4 tracer C o ixtrcg+2 => indx of advected cfc11 tracer C o ixtrcg+3 => indx of advected cfc12 tracer c if (trace_gas) then call radclw(lat ,lwupcgs ,t ,qm1(1,1,1) ,o3vmr, $ pbr ,pnm ,pmln ,piln ,plco2, $ plh2o,qm1(1,1,ixtrcg), qm1(1,1,ixtrcg+1), $ qm1(1,1,ixtrcg+2), qm1(1,1,ixtrcg+3) , $ effcld,tclrsf ,qrl ,flns ,flnt , $ flnsc ,flntc ,flwds ) else call trcmix(pmid, clat, coslat, n2o, ch4, cfc11, cfc12) call radclw(lat ,lwupcgs ,t ,qm1(1,1,1) ,o3vmr , $ pbr ,pnm ,pmln ,piln ,plco2 , $ plh2o ,n2o ,ch4 ,cfc11 ,cfc12 , $ effcld ,tclrsf ,qrl ,flns ,flnt , $ flnsc ,flntc ,flwds ) endif C C Convert units of longwave fields needed by rest of model from CGS to MKS C do i=1,plon flnt(i) = flnt(i)*1.e-3 flns(i) = flns(i)*1.e-3 flntc(i) = flntc(i)*1.e-3 flnsc(i) = flnsc(i)*1.e-3 flwds(i) = flwds(i)*1.e-3 end do C C Dump longwave radiation information to history tape buffer (diagnostics) C call outfld('FLNT ',flnt ,plond,lat,hbuf) call outfld('FLNTC ',flntc ,plond,lat,hbuf) call outfld('FLNS ',flns ,plond,lat,hbuf) call outfld('FLNSC ',flnsc ,plond,lat,hbuf) end if C C Interpolate radiation output arrays to model vertical grid. Currently this C is a do-nothing routine because radiation grid = model grid. C call fmrgrid(qrs ,qrl , $ qrs ,qrl ) C return end