#include <misc.h>#include <params.h>#define PCWDETRAINsubroutine tphysbc (ztodt,   pblht,   tpert,   ts,      &                    qpert,   precl,   precc,   precsl,  precsc,  &                    asdir,   asdif,   aldir,   aldif,   snowh,   &                    qrs,     qrl,     flwds,   fsns,    fsnt,    &                    flns,    flnt,    lwup,    srfrad,  sols,    &                    soll,    solsd,   solld,   cldo,    cldn,    &                    tcwato,  tcwatn,  qcwato,  qcwatn,  lcwato,  &                    lcwatn,  state,   tend,    icefrac, landfrac,&		    ocnfrac, tin, prcsnw   )!----------------------------------------------------------------------- ! ! Purpose: ! Tendency physics BEFORE coupling to land, sea, and ice models.! ! Method: ! Call physics subroutines and compute the following:!     o cloud calculations (cloud fraction, emissivity, etc.)!     o radiation calculations! Pass surface fields for separate surface flux calculations! Dump appropriate fields to history file.! ! Author: CCM1, CMS Contact: J. Truesdale! !-----------------------------------------------------------------------   use precision   use ppgrid   use phys_grid,     only: get_rlat_all_p, get_rlon_all_p   use cldwat,        only: pcond   use geopotential,  only: geopotential_t   use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, physics_ptend_init   use diagnostics,   only: diag_dynvar   use history,       only: outfld   use physconst,     only: gravit, latvap, cpair, tmelt, cappa, zvir, rair, rga   use radheat,       only: radheat_net   use constituents,  only: pcnst, pnats, ppcnst, qmin   use tracers,       only: dcconnam, ixcldw   use zm_conv,       only: zm_conv_evap, zm_convr   use time_manager,  only: is_first_step, get_nstep, get_curr_calday   use moistconvection, only: cmfmca   implicit none#include <comctl.h>!! Arguments!   real(r8), intent(in) :: ztodt                          ! 2 delta t (model time increment)   real(r8), intent(in) :: ts(pcols)                      ! surface temperature   real(r8), intent(in) :: tcwato(pcols,pver)             !cloud water old temperature   real(r8), intent(in) :: qcwato(pcols,pver)             ! cloud water old q   real(r8), intent(in) :: lcwato(pcols,pver)             ! cloud liquid water old q   real(r8), intent(in) :: icefrac(pcols)                 ! sea ice fraction (fraction)   real(r8), intent(in) :: landfrac(pcols)                ! land fraction (fraction)   real(r8), intent(in) :: ocnfrac(pcols)                 ! ocean fraction (fraction)   real(r8), intent(inout) :: pblht(pcols)                ! Planetary boundary layer height   real(r8), intent(inout) :: tpert(pcols)                ! Thermal temperature excess   real(r8), intent(inout) :: qpert(pcols,ppcnst)         ! Thermal humidity & constituent excess   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) :: snowh(pcols)                  ! Snow depth (liquid water equivalent)   real(r8), intent(inout) :: qrs(pcols,pver)            ! Shortwave heating rate   real(r8), intent(inout) :: qrl(pcols,pver)            ! Longwave  heating rate   real(r8), intent(inout) :: flwds(pcols)               ! Surface longwave down flux   real(r8), intent(inout) :: fsns(pcols)                   ! Surface solar absorbed flux   real(r8), intent(inout) :: fsnt(pcols)                   ! Net column abs solar flux at model top   real(r8), intent(inout) :: flns(pcols)                   ! Srf longwave cooling (up-down) flux   real(r8), intent(inout) :: flnt(pcols)                   ! Net outgoing lw flux at model top   real(r8), intent(in) :: lwup(pcols)                    ! Surface longwave up flux   real(r8), intent(out) :: srfrad(pcols)                 ! Net surface radiative flux (watts/m**2)   real(r8), intent(inout) :: sols(pcols)                   ! Direct beam solar rad. onto srf (sw)   real(r8), intent(inout) :: soll(pcols)                   ! Direct beam solar rad. onto srf (lw)   real(r8), intent(inout) :: solsd(pcols)                  ! Diffuse solar radiation onto srf (sw)   real(r8), intent(inout) :: solld(pcols)                  ! Diffuse solar radiation onto srf (lw)   real(r8), intent(out) :: precl(pcols)                  ! Large-scale precipitation rate   real(r8), intent(out) :: precc(pcols)                  ! Convective-scale preciptn rate   real(r8), intent(out) :: precsl(pcols)                 ! L.S. snowfall rate   real(r8), intent(out) :: precsc(pcols)                 ! C.S. snowfall rate   real(r8), intent(inout) :: cldo(pcols,pver)            !old cloud fraction   real(r8), intent(out) :: cldn(pcols,pver)              !new cloud fraction   real(r8), intent(out) :: tcwatn(pcols,pver)            !cloud water new temperature   real(r8), intent(out) :: qcwatn(pcols,pver)            ! cloud water new q   real(r8), intent(out) :: lcwatn(pcols,pver)            ! cloud liq. water new q   real(r8), intent(out) :: tin(pcols,pver)               ! input T, to compute FV output T   real(r8), intent(out) :: prcsnw(pcols)                 ! snowfall rate (precsl + precsc)   type(physics_state), intent(inout) :: state   type(physics_tend ), intent(inout) :: tend!!---------------------------Local workspace-----------------------------!   real(r8) :: rhdfda(pcols,pver)            ! dRh/dcloud, old    real(r8) :: rhu00 (pcols,pver)            ! Rh threshold for cloud, old   type(physics_ptend)   :: ptend                  ! indivdual parameterization tendencies   integer :: nstep                          ! current timestep number   real(r8) :: calday                        ! current calendar day   real(r8) :: clat(pcols)                   ! current latitudes(radians)   real(r8) :: clon(pcols)                   ! current longitudes(radians)   real(r8) :: zdu(pcols,pver)               ! detraining mass flux from deep convection   real(r8) :: ftem(pcols,pver)              ! Temporary workspace for outfld variables   real(r8) :: cmfdqr(pcols,pver)            ! dq/dt due to moist convective rainout   real(r8) :: cmfmc(pcols,pverp)            ! Convective mass flux--m sub c   real(r8) :: cmfsl(pcols,pver)             ! Moist convection lw stat energy flux   real(r8) :: cmflq(pcols,pver)             ! Moist convection total water flux   real(r8) :: dtcond(pcols,pver)            ! dT/dt due to moist processes   real(r8) :: dqcond(pcols,pver,ppcnst)     ! dq/dt due to moist processes   real(r8) cldst(pcols,pver)   real(r8) cltot(pcols)                      ! Diagnostic total cloud cover   real(r8) cllow(pcols)                      !       "     low  cloud cover   real(r8) clmed(pcols)                      !       "     mid  cloud cover   real(r8) clhgh(pcols)                      !       "     hgh  cloud cover   real(r8) cmfcme(pcols,pver)                ! cmf condensation - evaporation   real(r8) cmfdqr2(pcols,pver)               ! dq/dt due to moist convective rainout   real(r8) cmfmc2(pcols,pver)                ! Moist convection cloud mass flux   real(r8) cmfsl2(pcols,pver)                ! Moist convection lw stat energy flux   real(r8) cmflq2(pcols,pver)                ! Moist convection total water flux   real(r8) cnt(pcols)                        ! Top level of convective activity   real(r8) cnb(pcols)                        ! Lowest level of convective activity   real(r8) cnt2(pcols)                       ! Top level of convective activity   real(r8) cnb2(pcols)                       ! Bottom level of convective activity   real(r8) concld(pcols,pver)                real(r8) coszrs(pcols)                     ! Cosine solar zenith angle   real(r8) dlf(pcols,pver)                   ! Detraining cld H20 from convection   real(r8) fwaut(pcols,pver)                 real(r8) fsaut(pcols,pver)                 real(r8) fracw(pcols,pver)                 real(r8) fsacw(pcols,pver)                 real(r8) fsaci(pcols,pver)                 real(r8) nevapr(pcols,pver)                ! local evaporation of precipitation   real(r8) prain(pcols,pver)                 ! local formation of precipitation   real(r8) pflx(pcols,pverp)                 ! Conv rain flux thru out btm of lev   real(r8) precc2(pcols)                     ! Convective-scale preciptn rate   real(r8) preclp(pcols)                     ! sfc flux of precip from pcond   real(r8) prect(pcols)                      ! total (conv+large scale) precip rate   real(r8) qc(pcols,pver)                    ! dq/dt due to rainout terms   real(r8) qc2(pcols,pver)                   ! dq/dt due to rainout terms   real(r8) qme(pcols,pver)                   ! local condensation of cloud water   real(r8) qpert2(pcols,ppcnst)              ! Perturbation q   real(r8) rtdt                              ! 1./ztodt   real(r8) tpert2(pcols)                     ! Perturbation T   real(r8) tvm(pcols,pver)                   ! Virtual temperature   real(r8) pmxrgn(pcols,pverp)               ! Maximum values of pressure for each!                                             !    maximally overlapped region.!                                             !    0->pmxrgn(i,1) is range of pressure for!                                             !    1st region,pmxrgn(i,1)->pmxrgn(i,2) for!                                             !    2nd region, etc   integer lchnk                              ! chunk identifier   integer ncol                               ! number of atmospheric columns   integer nmxrgn(pcols)                      ! Number of maximally overlapped regions   integer  i,k,m                             ! Longitude, level, constituent indices                                           !  real(r8) engt                              ! Thermal   energy integral!  real(r8) engk                              ! Kinetic   energy integral!  real(r8) engp                              ! Potential energy integral   real(r8) clwp(pcols,pver)                  ! Presribed cloud liq. h2o path   real(r8) rel(pcols,pver)                   ! Liquid cloud particle effective radius   real(r8) rei(pcols,pver)                   ! Ice effective drop size (microns)   real(r8) fice(pcols,pver)                  ! Fractional ice content within cloud   real(r8) effcld(pcols,pver)                ! Effective cloud=cld*emis   real(r8) emis(pcols,pver)                  ! Cloud longwave emissivity   real(r8) clc(pcols)                        ! Total convective cloud (cloud scheme)   real(r8) qtend(pcols,pver)                 ! moisture tendencies   real(r8) ttend(pcols,pver)                 ! temp tendencies   real(r8) lctend(pcols,pver)                ! cloud liquid water tendencies   real(r8) rmelt(pcols,pver)                 ! heating rate due to phase change of precip   real(r8) zero(pcols,pverp)                 ! a dummy array   real(r8) clwp2(pcols,pver)                 ! in-cloud cloud water path   real(r8) gclwp2(pcols,pver)                ! grid-box cloud water path   real(r8) tgcwp(pcols)                      ! Vertically integrated cloud water path   real(r8) tgiwp(pcols)                      ! Vertically integrated ice water path   real(r8) tglwp(pcols)                      ! Vertically integrated liquid water path   real(r8) tpw(pcols)                        ! Total precipitable water   real(r8) hl (pcols)                        ! Liquid water scale height!   real(r8) dellow(pcols)                     ! delta p for bottom three levels of model   real(r8) tavg(pcols)                       ! mass weighted average temperature for !                                          ! Used for OUTFLD only                     !                                             real(r8) icimr(pcols,pver)                 ! in cloud ice mixing ratio   real(r8) icwmr(pcols,pver)                 ! in cloud water mixing ratio   real(r8) cldv(pcols,pver)                  ! cloud volume (fraction) occupied by rain or cloud water   real(r8) rain(pcols,pver)                  ! total precip mixing ratio   real(r8) icwmr1(pcols,pver)                ! in cloud water mixing ration for zhang scheme   real(r8) icwmr2(pcols,pver)                ! in cloud water mixing ration for hack scheme   real(r8) fracis(pcols,pver,ppcnst)         ! fraction of transported species that are insoluble   real(r8) evappct(pcols)                    ! Convective-scale preciptn rate   real(r8) timestep(pcols)!!     Variables for doing deep convective transport outside of zm_convr!   real(r8) mu2(pcols,pver)   real(r8) eu2(pcols,pver)   real(r8) du2(pcols,pver)   real(r8) md2(pcols,pver)   real(r8) ed2(pcols,pver)   real(r8) dp(pcols,pver)   real(r8) dsubcld(pcols)   integer jt(pcols)   integer maxg(pcols)   integer ideep(pcols)   integer lengath!!-----------------------------------------------------------------------!   lchnk = state%lchnk   ncol  = state%ncol   nstep = get_nstep()   calday = get_curr_calday()!! Output NSTEP for debugging!   timestep(:ncol) = nstep   call outfld ('NSTEP   ',timestep, pcols, lchnk)!!*** BAB's FV kludge!   tin(:ncol,:pver) = state%t(:ncol,:pver)!! Convert mixing ratio of non-water tracers to mass fraction of total! atmospheric mass (Overwrite non-water portions of q3m1).!   if (ppcnst > 1) then      call mr2mf (lchnk, ncol, state%q)   end if!! Set reciprocal of layer thickness! Set physics tendencies to 0!   state%rpdel(:ncol,:pver) = 1./state%pdel(:ncol,:pver)   tend %dTdt(:ncol,:pver)  = 0.   tend %dudt(:ncol,:pver)  = 0.   tend %dvdt(:ncol,:pver)  = 0.!! Compute initial geopotential heights and dry static energies!   call geopotential_t (state%lnpint, state%lnpmid  , state%pint,  &                        state%pmid  , state%pdel    , state%rpdel, &                        state%t     , state%q(1,1,1), rair , gravit , zvir   , &                        state%zi    , state%zm      , ncol      )   state%s(:ncol,:pver) = cpair*state%t(:ncol,:pver) + gravit*state%zm(:ncol,:pver)   call physics_ptend_init (ptend) ! Initialize parameterization tendency structure!! Make sure that input tracers are all positive (probably unnecessary)