!-------------------------------------------------------------------------------!physics data types module!-------------------------------------------------------------------------------module physics_types  use precision  use ppgrid,  only: pcols, pver  use constituents, only: pcnst, pnats, qmin, cnst_name  use tracers, only: ixcldw  implicit none  private          ! Make default type private to the module! Public types:  public physics_state  public physics_tend  public physics_ptend! Public interfaces  public physics_update  public physics_ptend_reset  public physics_ptend_init !-------------------------------------------------------------------------------  type physics_state     integer                                     :: &          lchnk,   &! chunk index          ncol      ! number of active columns     real(r8), dimension(pcols)                  :: &          ps,      &! surface pressure          phis      ! surface geopotential     real(r8), dimension(pcols,pver)             :: &          t,       &! temperature (K)          u,       &! zonal wind (m/s)          v,       &! meridional wind (m/s)          s,       &! dry static energy          omega,   &! vertical pressure velocity (Pa/s)           pmid,    &! midpoint pressure (Pa)           pdel,    &! layer thickness (Pa)          rpdel,   &! reciprocal of layer thickness (Pa)          lnpmid,  &! ln(pmid)          exner,   &! inverse exner function w.r.t. surface pressure (ps/p)^(R/cp)          zm        ! geopotential height above surface at midpoints (m)     real(r8), dimension(pcols,pver,pcnst+pnats) :: &          q         ! constituent mixing ratio (kg/kg moist air)     real(r8), dimension(pcols,pver+1)           :: &          pint,    &! interface pressure (Pa)          lnpint,  &! ln(pint)          zi        ! geopotential height above surface at interfaces (m)       end type physics_state!-------------------------------------------------------------------------------  type physics_tend     real(r8), dimension(pcols,pver)             :: dtdt, dudt, dvdt     real(r8), dimension(pcols     )             :: flx_net  end type physics_tend!-------------------------------------------------------------------------------! This is for tendencies returned from individual parameterizations  type physics_ptend     character*24 :: name    ! name of parameterization which produced tendencies.     logical ::             &          ls,               &! true if dsdt is returned          lu,               &! true if dudt is returned          lv,               &! true if dvdt is returned          lq(pcnst+pnats)    ! true if dqdt() is returned     integer ::             &          top_level,        &! top level index for which nonzero tendencies have been set          bot_level          ! bottom level index for which nonzero tendencies have been set     real(r8), dimension(pcols,pver)             :: &          s,                &! heating rate (J/kg/s)          u,                &! u momentum tendency (m/s/s)          v                  ! v momentum tendency (m/s/s)     real(r8), dimension(pcols,pver,pcnst+pnats) :: &          q                  ! consituent tendencies (kg/kg/s)  end type physics_ptend!===============================================================================contains!===============================================================================!===============================================================================  subroutine physics_update(state, tend, ptend, dt)!-----------------------------------------------------------------------! Update the state and or tendency structure with the parameterization tendencies!-----------------------------------------------------------------------    use geopotential, only: geopotential_dse    use physconst,    only: cpair, gravit, rair, zvir!------------------------------Arguments--------------------------------    type(physics_ptend), intent(inout)  :: ptend   ! Parameterization tendencies    type(physics_state), intent(inout)  :: state   ! Physics state variables    type(physics_tend ), intent(inout)  :: tend    ! Physics tendencies    real(r8), intent(in) :: dt                     ! time step!!---------------------------Local storage-------------------------------    integer :: i,k,m                               ! column,level,constituent indices    integer :: ncol                                ! number of columns    character*40 :: name    ! param and tracer name for qneg3!-----------------------------------------------------------------------    ncol = state%ncol! Update u,v fields    if(ptend%lu) then       do k = ptend%top_level, ptend%bot_level          do i = 1, ncol             state%u  (i,k) = state%u  (i,k) + ptend%u(i,k) * dt             tend%dudt(i,k) = tend%dudt(i,k) + ptend%u(i,k)          end do       end do    end if    if(ptend%lv) then       do k = ptend%top_level, ptend%bot_level          do i = 1, ncol             state%v  (i,k) = state%v  (i,k) + ptend%v(i,k) * dt             tend%dvdt(i,k) = tend%dvdt(i,k) + ptend%v(i,k)          end do       end do    end if! Update dry static energy    if(ptend%ls) then       do k = ptend%top_level, ptend%bot_level          do i = 1, ncol             state%s(i,k)   = state%s(i,k)   + ptend%s(i,k) * dt             tend%dtdt(i,k) = tend%dtdt(i,k) + ptend%s(i,k)/cpair          end do       end do    end if! Update constituents, all schemes use time split q: no tendency kept    do m = 1, pcnst+pnats       if(ptend%lq(m)) then          do k = ptend%top_level, ptend%bot_level             do i = 1,ncol                state%q(i,k,m) = state%q(i,k,m) + ptend%q(i,k,m) * dt             end do          end do! special test for cloud water (zero +/- 1.e-12 = 0)          if (ptend%name == 'pcond' .and. m == ixcldw) then             do k = 1,pver                do i = 1,ncol                   if (abs(state%q(i,k,m)) < 1.e-12) state%q(i,k,m) = 0.                end do             end do          end if! now test for mixing ratios which are too small          name = trim(ptend%name) // '/' // trim(cnst_name(m))          call qneg3(trim(name), state%lchnk, ncol, pcols, pver, 1, qmin(m), state%q(1,1,m))       end if    end do! Derive new temperature and geopotential fields if heating or water tendency not 0.    if (ptend%ls .or. ptend%lq(1)) then       call geopotential_dse(                                                                    &            state%lnpint, state%lnpmid, state%pint  , state%pmid  , state%pdel  , state%rpdel  , &            state%s     , state%q(1,1,1), rair      , gravit      , cpair       , zvir         , &            state%t     , state%zi    , state%zm    , ncol         )    end if! Reset all parameterization tendency flags to false    call physics_ptend_reset(ptend)  end subroutine physics_update!===============================================================================  subroutine physics_ptend_reset(ptend)!-----------------------------------------------------------------------! Reset the parameterization tendency structure to "empty"!-----------------------------------------------------------------------!------------------------------Arguments--------------------------------    type(physics_ptend), intent(inout)  :: ptend   ! Parameterization tendencies!-----------------------------------------------------------------------    integer :: m             ! Index for constiuent!-----------------------------------------------------------------------    if(ptend%ls) ptend%s = 0.    if(ptend%lu) ptend%u = 0.    if(ptend%lv) ptend%v = 0.    do m = 1, pcnst+pnats       if(ptend%lq(m)) ptend%q(:,:,m) = 0.    end do    ptend%name  = "none"    ptend%lq(:) = .FALSE.    ptend%ls    = .FALSE.    ptend%lu    = .FALSE.    ptend%lv    = .FALSE.    ptend%top_level = 1    ptend%bot_level = pver    return  end subroutine physics_ptend_reset!===============================================================================  subroutine physics_ptend_init(ptend)!-----------------------------------------------------------------------! Initialize the parameterization tendency structure to "empty"!-----------------------------------------------------------------------!------------------------------Arguments--------------------------------    type(physics_ptend), intent(inout)  :: ptend   ! Parameterization tendencies!-----------------------------------------------------------------------    ptend%name  = "none"    ptend%lq(:) = .true.    ptend%ls    = .true.    ptend%lu    = .true.    ptend%lv    = .true.    call physics_ptend_reset(ptend)    return  end subroutine physics_ptend_initend module physics_types