LCOV - code coverage report
Current view: | top level - physics/cam - convect_deep.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 59 | 93 | 63.4 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 5 | 5 | 100.0 %

              Line data    Source code
           1             :
           2             : module convect_deep
           3             : !---------------------------------------------------------------------------------
           4             : ! Purpose:
           5             : !
           6             : ! CAM interface to several deep convection interfaces. Currently includes:
           7             : !    Zhang-McFarlane (default)
           8             : !    Kerry Emanuel
           9             : !
          10             : !
          11             : ! Author: D.B. Coleman, Sep 2004
          12             : !
          13             : !---------------------------------------------------------------------------------
          14             :    use shr_kind_mod, only: r8=>shr_kind_r8
          15             :    use ppgrid,       only: pver, pcols, pverp
          16             :    use cam_logfile,  only: iulog
          17             :
          18             :    implicit none
          19             :
          20             :    save
          21             :    private                         ! Make default type private to the module
          22             :
          23             : ! Public methods
          24             :
          25             :    public ::&
          26             :       convect_deep_register,           &! register fields in physics buffer
          27             :       convect_deep_init,               &! initialize donner_deep module
          28             :       convect_deep_tend,               &! return tendencies
          29             :       convect_deep_tend_2,             &! return tendencies
          30             :       deep_scheme_does_scav_trans             ! = .t. if scheme does scavenging and conv. transport
          31             :
          32             : ! Private module data
          33             :    character(len=16) :: deep_scheme    ! default set in phys_control.F90, use namelist to change
          34             : ! Physics buffer indices
          35             :    integer     ::  icwmrdp_idx      = 0
          36             :    integer     ::  rprddp_idx       = 0
          37             :    integer     ::  nevapr_dpcu_idx  = 0
          38             :    integer     ::  cldtop_idx       = 0
          39             :    integer     ::  cldbot_idx       = 0
          40             :    integer     ::  cld_idx          = 0
          41             :    integer     ::  fracis_idx       = 0
          42             :
          43             :    integer     ::  pblh_idx        = 0
          44             :    integer     ::  tpert_idx       = 0
          45             :    integer     ::  prec_dp_idx     = 0
          46             :    integer     ::  snow_dp_idx     = 0
          47             :
          48             :    integer     ::  ttend_dp_idx        = 0
          49             :
          50             : !=========================================================================================
          51             :   contains
          52             :
          53             : !=========================================================================================
          54     2978352 : function deep_scheme_does_scav_trans()
          55             : !
          56             : ! Function called by tphysbc to determine if it needs to do scavenging and convective transport
          57             : ! or if those have been done by the deep convection scheme. Each scheme could have its own
          58             : ! identical query function for a less-knowledgable interface but for now, we know that KE
          59             : ! does scavenging & transport, and ZM doesn't
          60             : !
          61             :
          62             :   logical deep_scheme_does_scav_trans
          63             :
          64     1489176 :   deep_scheme_does_scav_trans = .false.
          65             :
          66     1489176 :   if ( deep_scheme .eq. 'KE' ) deep_scheme_does_scav_trans = .true.
          67             :
          68             :   return
          69             :
          70             : end function deep_scheme_does_scav_trans
          71             :
          72             : !=========================================================================================
          73        1536 : subroutine convect_deep_register
          74             :
          75             : !----------------------------------------
          76             : ! Purpose: register fields with the physics buffer
          77             : !----------------------------------------
          78             :
          79             :
          80             :   use physics_buffer, only : pbuf_add_field, dtype_r8
          81             :   use zm_conv_intr, only: zm_conv_register
          82             :   use phys_control, only: phys_getopts, use_gw_convect_dp
          83             :
          84             :   implicit none
          85             :
          86             :   integer idx
          87             :
          88             :   ! get deep_scheme setting from phys_control
          89        1536 :   call phys_getopts(deep_scheme_out = deep_scheme)
          90             :
          91        1536 :   select case ( deep_scheme )
          92             :   case('ZM') !    Zhang-McFarlane (default)
          93        1536 :      call zm_conv_register
          94             :
          95             :   case('off', 'UNICON') ! Off needs to setup the following fields
          96           0 :    call pbuf_add_field('ICWMRDP',    'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx)
          97           0 :    call pbuf_add_field('RPRDDP',     'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx)
          98           0 :    call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx)
          99           0 :    call pbuf_add_field('PREC_DP',    'physpkg',dtype_r8,(/pcols/),     prec_dp_idx)
         100        1536 :    call pbuf_add_field('SNOW_DP',    'physpkg',dtype_r8,(/pcols/),     snow_dp_idx)
         101             :
         102             :   end select
         103             :
         104             :   ! If gravity waves from deep convection are on, output this field.
         105        1536 :   if (use_gw_convect_dp .and. deep_scheme == 'ZM') then
         106        1536 :      call pbuf_add_field('TTEND_DP','physpkg',dtype_r8,(/pcols,pver/),ttend_dp_idx)
         107             :   end if
         108             :
         109        1536 : end subroutine convect_deep_register
         110             :
         111             : !=========================================================================================
         112             :
         113             :
         114             :
         115        1536 : subroutine convect_deep_init(pref_edge)
         116             :
         117             : !----------------------------------------
         118             : ! Purpose:  declare output fields, initialize variables needed by convection
         119             : !----------------------------------------
         120             :
         121        1536 :   use cam_history,    only: addfld
         122             :   use pmgrid,         only: plevp
         123             :   use spmd_utils,     only: masterproc
         124             :   use zm_conv_intr,   only: zm_conv_init
         125             :   use cam_abortutils, only: endrun
         126             :
         127             :   use physics_buffer, only: physics_buffer_desc, pbuf_get_index
         128             :
         129             :   implicit none
         130             :
         131             :   real(r8),intent(in) :: pref_edge(plevp)        ! reference pressures at interfaces
         132             :
         133           0 :   select case ( deep_scheme )
         134             :   case('off')
         135           0 :      if (masterproc) write(iulog,*)'convect_deep: no deep convection selected'
         136             :   case('CLUBB_SGS')
         137           0 :      if (masterproc) write(iulog,*)'convect_deep: CLUBB_SGS selected'
         138             :   case('ZM')
         139        1536 :      if (masterproc) write(iulog,*)'convect_deep initializing Zhang-McFarlane convection'
         140        1536 :      call zm_conv_init(pref_edge)
         141             :   case('UNICON')
         142           0 :      if (masterproc) write(iulog,*)'convect_deep: deep convection done by UNICON'
         143             :   case('SPCAM')
         144           0 :      if (masterproc) write(iulog,*)'convect_deep: deep convection done by SPCAM'
         145           0 :      return
         146             :   case default
         147        1536 :      if (masterproc) write(iulog,*)'WARNING: convect_deep: no deep convection scheme. May fail.'
         148             :   end select
         149             :
         150        1536 :   icwmrdp_idx     = pbuf_get_index('ICWMRDP')
         151        1536 :   rprddp_idx      = pbuf_get_index('RPRDDP')
         152        1536 :   nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
         153        1536 :   prec_dp_idx     = pbuf_get_index('PREC_DP')
         154        1536 :   snow_dp_idx     = pbuf_get_index('SNOW_DP')
         155             :
         156        1536 :   cldtop_idx = pbuf_get_index('CLDTOP')
         157        1536 :   cldbot_idx = pbuf_get_index('CLDBOT')
         158        1536 :   cld_idx    = pbuf_get_index('CLD')
         159        1536 :   fracis_idx = pbuf_get_index('FRACIS')
         160             :
         161        1536 :   pblh_idx   = pbuf_get_index('pblh')
         162        1536 :   tpert_idx  = pbuf_get_index('tpert')
         163             :
         164        3072 :   call addfld ('ICWMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Deep Convection in-cloud water mixing ratio ' )
         165             :
         166        1536 : end subroutine convect_deep_init
         167             : !=========================================================================================
         168             : !subroutine convect_deep_tend(state, ptend, tdt, pbuf)
         169             :
         170    62805456 : subroutine convect_deep_tend( &
         171             :      mcon    ,cme     ,          &
         172             :      zdu      , &
         173             :      rliq    ,rice     , &
         174             :      ztodt   , &
         175             :      state   ,ptend   ,landfrac ,pbuf)
         176             :
         177             :
         178        1536 :    use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init
         179             :
         180             :    use cam_history,    only: outfld
         181             :    use constituents,   only: pcnst
         182             :    use zm_conv_intr,   only: zm_conv_tend
         183             :    use cam_history,    only: outfld
         184             :    use physconst,      only: cpair
         185             :    use physics_buffer, only: physics_buffer_desc, pbuf_get_field
         186             :
         187             : ! Arguments
         188             :    type(physics_state), intent(in ) :: state   ! Physics state variables
         189             :    type(physics_ptend), intent(out) :: ptend   ! individual parameterization tendencies
         190             :
         191             :
         192             :    type(physics_buffer_desc), pointer :: pbuf(:)
         193             :    real(r8), intent(in) :: ztodt               ! 2 delta t (model time increment)
         194             :    real(r8), intent(in) :: landfrac(pcols)     ! Land fraction
         195             :
         196             :
         197             :    real(r8), intent(out) :: mcon(pcols,pverp)  ! Convective mass flux--m sub c
         198             :    real(r8), intent(out) :: cme(pcols,pver)    ! cmf condensation - evaporation
         199             :    real(r8), intent(out) :: zdu(pcols,pver)    ! detraining mass flux
         200             :
         201             :    real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
         202             :    real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals
         203             :
         204     1495368 :    real(r8), pointer :: prec(:)   ! total precipitation
         205     1495368 :    real(r8), pointer :: snow(:)   ! snow from ZM convection
         206             :
         207     1495368 :    real(r8), pointer, dimension(:) :: jctop
         208     1495368 :    real(r8), pointer, dimension(:) :: jcbot
         209     1495368 :    real(r8), pointer, dimension(:,:,:) :: cld
         210     1495368 :    real(r8), pointer, dimension(:,:) :: ql        ! wg grid slice of cloud liquid water.
         211     1495368 :    real(r8), pointer, dimension(:,:) :: rprd      ! rain production rate
         212     1495368 :    real(r8), pointer, dimension(:,:,:) :: fracis  ! fraction of transported species that are insoluble
         213             :
         214     1495368 :    real(r8), pointer, dimension(:,:) :: evapcdp   ! Evaporation of deep convective precipitation
         215             :
         216     1495368 :    real(r8), pointer :: pblh(:)                ! Planetary boundary layer height
         217     1495368 :    real(r8), pointer :: tpert(:)               ! Thermal temperature excess
         218             :
         219             :    ! Temperature tendency from deep convection (pbuf pointer).
         220     1495368 :    real(r8), pointer, dimension(:,:) :: ttend_dp
         221             :
         222             :    real(r8) zero(pcols, pver)
         223             :
         224             :    integer i, k
         225             :
         226     1495368 :    call pbuf_get_field(pbuf, cldtop_idx,  jctop )
         227     1495368 :    call pbuf_get_field(pbuf, cldbot_idx,  jcbot )
         228     1495368 :    call pbuf_get_field(pbuf, icwmrdp_idx, ql    )
         229             :
         230           0 :   select case ( deep_scheme )
         231             :   case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend
         232           0 :     zero = 0
         233           0 :     mcon = 0
         234           0 :     cme = 0
         235           0 :     zdu = 0
         236           0 :     rliq = 0
         237           0 :     rice = 0
         238             :
         239           0 :     call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
         240             :
         241             : !
         242             : ! Associate pointers with physics buffer fields
         243             : !
         244             :
         245           0 :     call pbuf_get_field(pbuf, cld_idx,         cld,    start=(/1,1/),   kount=(/pcols,pver/) )
         246           0 :     call pbuf_get_field(pbuf, rprddp_idx,      rprd )
         247           0 :     call pbuf_get_field(pbuf, fracis_idx,      fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
         248           0 :     call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
         249           0 :     call pbuf_get_field(pbuf, prec_dp_idx,     prec )
         250           0 :     call pbuf_get_field(pbuf, snow_dp_idx,     snow )
         251             :
         252           0 :     prec=0
         253           0 :     snow=0
         254             :
         255           0 :     jctop = pver
         256           0 :     jcbot = 1._r8
         257           0 :     cld = 0
         258           0 :     ql = 0
         259           0 :     rprd = 0
         260           0 :     fracis = 0
         261           0 :     evapcdp = 0
         262             :
         263             :   case('ZM') !    1 ==> Zhang-McFarlane (default)
         264     1495368 :      call pbuf_get_field(pbuf, pblh_idx,  pblh)
         265     1495368 :      call pbuf_get_field(pbuf, tpert_idx, tpert)
         266             :
         267             :      call zm_conv_tend( pblh    ,mcon    ,cme     , &
         268             :           tpert   ,zdu      , &
         269             :           rliq    ,rice    , &
         270             :           ztodt   , &
         271             :           jctop, jcbot , &
         272     2990736 :           state   ,ptend   ,landfrac, pbuf)
         273             :
         274             :   end select
         275             :
         276             :   ! If we added temperature tendency to pbuf, set it now.
         277             :
         278     1495368 :   if (ttend_dp_idx > 0) then
         279     1495368 :      call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp)
         280  2323627992 :      ttend_dp(:state%ncol,:pver) = ptend%s(:state%ncol,:pver)/cpair
         281             :   end if
         282             :
         283     1495368 :   call outfld( 'ICWMRDP ', ql  , pcols, state%lchnk )
         284             :
         285     2990736 : end subroutine convect_deep_tend
         286             : !=========================================================================================
         287             :
         288             :
         289    62545392 : subroutine convect_deep_tend_2( state,  ptend,  ztodt, pbuf)
         290             :
         291     1495368 :    use physics_types, only: physics_state, physics_ptend, physics_ptend_init
         292             :
         293             :    use physics_buffer,  only: physics_buffer_desc
         294             :    use constituents, only: pcnst
         295             :    use zm_conv_intr, only: zm_conv_tend_2
         296             :
         297             : ! Arguments
         298             :    type(physics_state), intent(in ) :: state          ! Physics state variables
         299             :    type(physics_ptend), intent(out) :: ptend          ! indivdual parameterization tendencies
         300             :
         301             :    type(physics_buffer_desc), pointer :: pbuf(:)
         302             :
         303             :    real(r8), intent(in) :: ztodt                          ! 2 delta t (model time increment)
         304             :
         305             :
         306     1489176 :    if ( deep_scheme .eq. 'ZM' ) then  ! Zhang-McFarlane
         307     1489176 :       call zm_conv_tend_2( state,   ptend,  ztodt,  pbuf)
         308             :    else
         309           0 :       call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
         310             :    end if
         311             :
         312             :
         313     1489176 : end subroutine convect_deep_tend_2
         314             :
         315             :
         316             : end module convect_deep

Generated by: LCOV version 1.14