tphysac.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

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

subroutine tphysac (ztodt,   pblh,    qpert,   tpert,  shf,  &
                    taux,    tauy,    cflx,    sgh,    lhf,  &
                    landfrac,snowh,   tref,    precc,  precl,  &
                    tin,     state,   tend,    ocnfrac )
!----------------------------------------------------------------------- 
! 
! Purpose: 
! Tendency physics after coupling to land, sea, and ice models.
! Computes the following:
!   o Radon surface flux and decay (optional)
!   o Vertical diffusion and planetary boundary layer
!   o Dry deposition for sulfur cycle (optional)
!   o Multiple gravity wave drag
! 
! Method: 
! <Describe the algorithm(s) used in the routine.> 
! <Also include any applicable external references.> 
! 
! Author: CCM1, CMS Contact: J. Truesdale
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid,             only: pcols, pver
   use chemistry,          only: chem_driver
   use gw_drag,            only: gw_intr
   use vertical_diffusion, only: vd_intr
   use physics_types,      only: physics_state, physics_tend, physics_ptend, physics_update, physics_ptend_init
   use constituents,       only: ppcnst, qmin
   use tracers,            only: ixtrct
   use physconst,          only: zvir, gravit, rhoh2o, latvap

   implicit none

#include <comctl.h>
!
! Arguments
!
   real(r8), intent(in) :: ztodt                  ! Two times model timestep (2 delta-t)
   real(r8), intent(in) :: landfrac(pcols)        ! Land fraction
   real(r8), intent(in) :: ocnfrac(pcols)         ! Land fraction
   real(r8), intent(in) :: snowh(pcols)           ! snow depth (liquid water equivalent)
   real(r8), intent(in) :: tref(pcols)            ! 2m air temperature
   real(r8), intent(in) :: precc(pcols)           ! convective precipitation
   real(r8), intent(in) :: precl(pcols)           ! large-scale precipitation
   real(r8), intent(out) :: pblh(pcols)           ! Planetary boundary layer height
   real(r8), intent(out) :: qpert(pcols,ppcnst)   ! Moisture/constit. perturbation (PBL)
   real(r8), intent(out) :: tpert(pcols)          ! Temperature perturbation (PBL)
   real(r8), intent(inout) :: shf(pcols)          ! Sensible heat flux (w/m^2)
   real(r8), intent(in) :: taux(pcols)            ! X surface stress (zonal)
   real(r8), intent(in) :: tauy(pcols)            ! Y surface stress (meridional)
   real(r8), intent(inout) :: cflx(pcols,ppcnst)  ! Surface constituent flux (kg/m^2/s)
   real(r8), intent(in) :: sgh(pcols)             ! Std. deviation of orography for gwd
   real(r8), intent(inout) :: lhf(pcols)          ! Latent heat flux (w/m^2)
   real(r8), intent(in) :: tin(pcols, pver) ! input T, to compute FV output T

   type(physics_state), intent(inout) :: state
   type(physics_tend ), intent(inout) :: tend
!
!---------------------------Local workspace-----------------------------
!
   type(physics_ptend) :: ptend                  ! indivdual parameterization tendencies

   integer :: lchnk                                ! chunk identifier
   integer :: ncol                                 ! number of atmospheric columns
   integer i                 ! Longitude, level indices
   integer :: yr, mon, day, tod       ! components of a date

   logical :: labort                            ! abort flag

   real(r8) tvm(pcols,pver)           ! virtual temperature
   real(r8) prect(pcols)              ! total precipitation
   real(r8) surfric(pcols)              ! surface friction velocity
   real(r8) obklen(pcols)             ! Obukhov length
!
!-----------------------------------------------------------------------
   lchnk = state%lchnk
   ncol  = state%ncol
!
! accumulate fluxes into net flux array
!
   do i=1,ncol
      tend%flx_net(i) = tend%flx_net(i) + shf(i) + (precc(i) + precl(i))*latvap*rhoh2o
   end do

! Convert mixing ratio of non-water tracers to mass fraction of total
! atmospheric mass (Overwrite non-water portions of q).

   if (ppcnst > 1) then
      call mr2mf (lchnk, ncol, state%q)
   end if

! Initialize parameterization tendency structure

   call physics_ptend_init(ptend)

! Check if latent heat flux exceeds the total moisture content of the
! lowest model layer, thereby creating negative moisture.

   call qneg4('TPHYSAC '       ,lchnk               ,ncol  ,ztodt ,          &
              state%q(1,pver,1),state%rpdel(1,pver) ,shf ,lhf ,cflx(1,1) )

!===================================================
! Source/sink terms for advected tracers.
!===================================================

   if ( trace_test1 .or. trace_test2 .or. trace_test3 ) then
      call rnsfwcrp( lchnk, ncol, landfrac, cflx(:,ixtrct))
      call rndecay( lchnk, ncol, state%q(:,:,ixtrct), ztodt, ptend%q(:,:,ixtrct))
      ptend%lq(ixtrct) = .TRUE.
      if (trace_test3) state%q(:ncol,pver,ixtrct+2) =  0.
   end if

! Advected greenhouse trace gases:

   if (trace_gas) call chem_driver (state, ptend, cflx, ztodt)

! Add tendencies to cummulative model tendencies and update profiles

   call physics_update (state, tend, ptend, ztodt)

!===================================================
! Vertical diffusion/pbl calculation
! Call vertical diffusion code (pbl, free atmosphere and molecular)
!===================================================

   call vd_intr (ztodt    ,state    ,taux     ,tauy     , shf    ,&
                 cflx     ,pblh     ,tpert    ,qpert    , surfric  ,&
                 obklen   ,ptend    )

   call physics_update (state, tend, ptend, ztodt)

!===================================================
! Gravity wave drag
!===================================================

   call gw_intr (state   ,sgh     ,pblh    ,ztodt   , ptend )
   call physics_update (state, tend, ptend, ztodt)

!*** BAB's FV kludge

   state%t(:ncol,:pver) = tin(:ncol,:pver) + ztodt*tend%dtdt(:ncol,:pver)

   if (aqua_planet) then
      labort = .false.
      do i=1,ncol
         if (ocnfrac(i) /= 1.) labort = .true.
      end do
      if (labort) then
         write(6,*) 'ERROR:  grid contains non-ocean point'
         call endrun ()
      endif
   endif
!
! Convert mass fractions of non-water tracers back to mixing ratios.
! (Overwrite non-water portions of q).
!
   if (ppcnst > 1) then
      call mf2mr (lchnk, ncol, state%q)
   end if

   return
end subroutine tphysac