tphysbc.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 775 行 · 第 1/3 页

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

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