LCOV - code coverage report
Current view: | top level - physics/cam - convect_shallow.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 347 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 4 | 0.0 %

              Line data    Source code
           1             :    module convect_shallow
           2             :
           3             :    !----------------------------------------------- !
           4             :    ! Purpose:                                       !
           5             :    !                                                !
           6             :    ! CAM interface to the shallow convection scheme !
           7             :    !                                                !
           8             :    ! Author: D.B. Coleman                           !
           9             :    !         Sungsu Park. Jan. 2010.                !
          10             :    !                                                !
          11             :    !----------------------------------------------- !
          12             :
          13             :    use shr_kind_mod,      only : r8=>shr_kind_r8
          14             :    use physconst,         only : cpair, zvir
          15             :    use ppgrid,            only : pver, pcols, pverp
          16             :    use zm_conv_evap,      only : zm_conv_evap_run
          17             :    use zm_conv_intr,      only : zmconv_ke, zmconv_ke_lnd,  zmconv_org
          18             :    use cam_history,       only : outfld, addfld, horiz_only
          19             :    use cam_logfile,       only : iulog
          20             :    use phys_control,      only : phys_getopts
          21             :
          22             :    implicit none
          23             :    private
          24             :    save
          25             :
          26             :    public :: &
          27             :              convect_shallow_register,       & ! Register fields in physics buffer
          28             :              convect_shallow_init,           & ! Initialize shallow module
          29             :              convect_shallow_tend,           & ! Return tendencies
          30             :              convect_shallow_use_shfrc         !
          31             :
          32             :    ! The following namelist variable controls which shallow convection package is used.
          33             :    !        'Hack'   = Hack shallow convection (default)
          34             :    !        'UW'     = UW shallow convection by Sungsu Park and Christopher S. Bretherton
          35             :    !        'UNICON' = General Convection Model by Sungsu Park
          36             :    !        'off'    = No shallow convection
          37             :
          38             :    character(len=16) :: shallow_scheme      ! Default set in phys_control.F90, use namelist to change
          39             :    character(len=16) :: microp_scheme       ! Microphysics scheme
          40             :    logical           :: history_amwg        ! output the variables used by the AMWG diag package
          41             :    logical           :: history_budget      ! Output tendencies and state variables for CAM4 T, qv, ql, qi
          42             :    integer           :: history_budget_histfile_num ! output history file number for budget fields
          43             :
          44             :    ! Physics buffer indices
          45             :    integer    ::     icwmrsh_idx    = 0
          46             :    integer    ::      rprdsh_idx    = 0
          47             :    integer    ::     rprdtot_idx    = 0
          48             :    integer    ::      cldtop_idx    = 0
          49             :    integer    ::      cldbot_idx    = 0
          50             :    integer    ::        cush_idx    = 0
          51             :    integer    :: nevapr_shcu_idx    = 0
          52             :    integer    ::       shfrc_idx    = 0
          53             :    integer    ::         cld_idx    = 0
          54             :    integer    ::      concld_idx    = 0
          55             :    integer    ::      rprddp_idx    = 0
          56             :    integer    ::         tke_idx    = 0
          57             :
          58             :    integer    ::       qpert_idx    = 0
          59             :    integer    ::       pblh_idx     = 0
          60             :    integer    ::    prec_sh_idx     = 0
          61             :    integer    ::    snow_sh_idx     = 0
          62             :    integer    :: cmfmc_sh_idx       = 0
          63             :    integer    :: sh_e_ed_ratio_idx  = 0
          64             :
          65             :    integer    ::  ttend_sh_idx      = 0
          66             :
          67             :    integer :: & ! field index in physics buffer
          68             :       sh_flxprc_idx, &
          69             :       sh_flxsnw_idx, &
          70             :       sh_cldliq_idx, &
          71             :       sh_cldice_idx
          72             :
          73             :    contains
          74             :
          75             :   !=============================================================================== !
          76             :   !                                                                                !
          77             :   !=============================================================================== !
          78             :
          79           0 :   subroutine convect_shallow_register
          80             :
          81             :   !-------------------------------------------------- !
          82             :   ! Purpose : Register fields with the physics buffer !
          83             :   !-------------------------------------------------- !
          84             :
          85             :   use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls
          86             :   use phys_control, only: use_gw_convect_sh
          87             :   use unicon_cam,     only: unicon_cam_register
          88             :
          89           0 :   call phys_getopts( shallow_scheme_out = shallow_scheme, microp_scheme_out = microp_scheme)
          90             :
          91             :   ! SPCAM registers its own fields
          92           0 :   if (shallow_scheme == 'SPCAM') return
          93             :
          94           0 :   call pbuf_add_field('ICWMRSH',    'physpkg' ,dtype_r8,(/pcols,pver/),       icwmrsh_idx )
          95           0 :   call pbuf_add_field('RPRDSH',     'physpkg' ,dtype_r8,(/pcols,pver/),       rprdsh_idx )
          96           0 :   call pbuf_add_field('RPRDTOT',    'physpkg' ,dtype_r8,(/pcols,pver/),       rprdtot_idx )
          97           0 :   call pbuf_add_field('CLDTOP',     'physpkg' ,dtype_r8,(/pcols,1/),          cldtop_idx )
          98           0 :   call pbuf_add_field('CLDBOT',     'physpkg' ,dtype_r8,(/pcols,1/),          cldbot_idx )
          99           0 :   call pbuf_add_field('cush',       'global'  ,dtype_r8,(/pcols,dyn_time_lvls/), cush_idx )
         100           0 :   call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/),       nevapr_shcu_idx )
         101           0 :   call pbuf_add_field('PREC_SH',    'physpkg' ,dtype_r8,(/pcols/),            prec_sh_idx )
         102           0 :   call pbuf_add_field('SNOW_SH',    'physpkg' ,dtype_r8,(/pcols/),            snow_sh_idx )
         103             :   ! Updraft mass flux by shallow convection [ kg/s/m2 ]
         104           0 :   call pbuf_add_field('CMFMC_SH',   'physpkg' ,dtype_r8,(/pcols,pverp/),      cmfmc_sh_idx )
         105             :
         106           0 :   if (shallow_scheme .eq. 'UW' .or. shallow_scheme .eq. 'UNICON') then
         107           0 :      call pbuf_add_field('shfrc', 'physpkg', dtype_r8, (/pcols,pver/), shfrc_idx)
         108             :   end if
         109           0 :   if( shallow_scheme .eq. 'UW' ) then
         110           0 :       call pbuf_add_field('SH_E_ED_RATIO', 'physpkg', dtype_r8, (/pcols,pver/), sh_e_ed_ratio_idx)
         111             :   endif
         112             :
         113             : ! shallow interface gbm flux_convective_cloud_rain+snow (kg/m2/s)
         114           0 :   call pbuf_add_field('SH_FLXPRC','physpkg',dtype_r8,(/pcols,pverp/),sh_flxprc_idx)
         115             :
         116             : ! shallow interface gbm flux_convective_cloud_snow (kg/m2/s)
         117           0 :   call pbuf_add_field('SH_FLXSNW','physpkg',dtype_r8,(/pcols,pverp/),sh_flxsnw_idx)
         118             :
         119             : ! shallow gbm cloud liquid water (kg/kg)
         120           0 :   call pbuf_add_field('SH_CLDLIQ','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq_idx)
         121             :
         122             : ! shallow gbm cloud ice water (kg/kg)
         123           0 :   call pbuf_add_field('SH_CLDICE','physpkg',dtype_r8,(/pcols,pver/),sh_cldice_idx)
         124             :
         125             :   ! If gravity waves from shallow convection are on, output this field.
         126           0 :   if (use_gw_convect_sh) then
         127           0 :      call pbuf_add_field('TTEND_SH','physpkg',dtype_r8,(/pcols,pver/),ttend_sh_idx)
         128             :   end if
         129             :
         130           0 :   if (shallow_scheme .eq. 'UNICON') then
         131           0 :      call unicon_cam_register()
         132             :   end if
         133             :
         134           0 :   end subroutine convect_shallow_register
         135             :
         136             :   !=============================================================================== !
         137             :   !                                                                                !
         138             :   !=============================================================================== !
         139             :
         140             :
         141           0 :   subroutine convect_shallow_init(pref_edge, pbuf2d)
         142             :
         143             :   !------------------------------------------------------------------------------- !
         144             :   ! Purpose : Declare output fields, and initialize variables needed by convection !
         145             :   !------------------------------------------------------------------------------- !
         146             :
         147           0 :   use cam_history,       only : addfld, add_default
         148             :   use ppgrid,            only : pcols, pver
         149             :   use hk_conv,           only : mfinti
         150             :   use uwshcu,            only : init_uwshcu
         151             :   use unicon_cam,        only : unicon_cam_init
         152             :   use physconst,         only : rair, gravit, latvap, rhoh2o, zvir, &
         153             :                                 cappa, latice, mwdry, mwh2o
         154             :   use pmgrid,            only : plev, plevp
         155             :   use spmd_utils,        only : masterproc
         156             :   use cam_abortutils,    only : endrun
         157             :   use phys_control,      only : cam_physpkg_is
         158             :
         159             :   use physics_buffer,    only : pbuf_get_index, physics_buffer_desc, pbuf_set_field
         160             :
         161             :   real(r8),                  intent(in) :: pref_edge(plevp)  ! Reference pressures at interfaces
         162             :   type(physics_buffer_desc), pointer    :: pbuf2d(:,:)
         163             :
         164             :   integer limcnv                                   ! Top interface level limit for convection
         165             :   integer k
         166             :   character(len=16)          :: eddy_scheme
         167             :
         168             :   ! SPCAM does its own convection
         169           0 :   if (shallow_scheme == 'SPCAM') return
         170             :
         171             :   ! ------------------------------------------------- !
         172             :   ! Variables for detailed abalysis of UW-ShCu scheme !
         173             :   ! ------------------------------------------------- !
         174             :
         175           0 :   call addfld( 'qt_pre_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qt_preCU'                                   )
         176           0 :   call addfld( 'sl_pre_Cu',  (/ 'lev' /),  'I', 'J/kg',  'sl_preCU'                                   )
         177           0 :   call addfld( 'slv_pre_Cu', (/ 'lev' /),  'I', 'J/kg',  'slv_preCU'                                  )
         178           0 :   call addfld( 'u_pre_Cu',   (/ 'lev' /),  'I', 'm/s',   'u_preCU'                                    )
         179           0 :   call addfld( 'v_pre_Cu',   (/ 'lev' /),  'I', 'm/s',   'v_preCU'                                    )
         180           0 :   call addfld( 'qv_pre_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qv_preCU'                                   )
         181           0 :   call addfld( 'ql_pre_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'ql_preCU'                                   )
         182           0 :   call addfld( 'qi_pre_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qi_preCU'                                   )
         183           0 :   call addfld( 't_pre_Cu',   (/ 'lev' /),  'I', 'K',     't_preCU'                                    )
         184           0 :   call addfld( 'rh_pre_Cu',  (/ 'lev' /),  'I', '%',     'rh_preCU'                                   )
         185             :
         186           0 :   call addfld( 'qt_aft_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qt_afterCU'                                 )
         187           0 :   call addfld( 'sl_aft_Cu',  (/ 'lev' /),  'I', 'J/kg',  'sl_afterCU'                                 )
         188           0 :   call addfld( 'slv_aft_Cu', (/ 'lev' /),  'I', 'J/kg',  'slv_afterCU'                                )
         189           0 :   call addfld( 'u_aft_Cu',   (/ 'lev' /),  'I', 'm/s',   'u_afterCU'                                  )
         190           0 :   call addfld( 'v_aft_Cu',   (/ 'lev' /),  'I', 'm/s',   'v_afterCU'                                  )
         191           0 :   call addfld( 'qv_aft_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qv_afterCU'                                 )
         192           0 :   call addfld( 'ql_aft_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'ql_afterCU'                                 )
         193           0 :   call addfld( 'qi_aft_Cu',  (/ 'lev' /),  'I', 'kg/kg', 'qi_afterCU'                                 )
         194           0 :   call addfld( 't_aft_Cu',   (/ 'lev' /),  'I', 'K',     't_afterCU'                                  )
         195           0 :   call addfld( 'rh_aft_Cu',  (/ 'lev' /),  'I', '%',     'rh_afterCU'                                 )
         196             :
         197           0 :   call addfld( 'tten_Cu',    (/ 'lev' /),  'I', 'K/s',   'Temperature tendency by cumulus convection' )
         198           0 :   call addfld( 'rhten_Cu',   (/ 'lev' /),  'I', '%/s',   'RH tendency by cumumus convection'          )
         199             :
         200             :   ! ------------------------------------------- !
         201             :   ! Common Output for Shallow Convection Scheme !
         202             :   ! ------------------------------------------- !
         203             :
         204           0 :   call addfld( 'CMFDT',      (/ 'lev' /),  'A', 'K/s',      'T tendency - shallow convection'                           )
         205           0 :   call addfld( 'CMFDQ',      (/ 'lev' /),  'A', 'kg/kg/s',  'QV tendency - shallow convection'                          )
         206           0 :   call addfld( 'CMFDLIQ',    (/ 'lev' /),  'A', 'kg/kg/s',  'Cloud liq tendency - shallow convection'                   )
         207           0 :   call addfld( 'CMFDICE',    (/ 'lev' /),  'A', 'kg/kg/s',  'Cloud ice tendency - shallow convection'                   )
         208           0 :   call addfld( 'CMFDQR',     (/ 'lev' /),  'A', 'kg/kg/s',  'Q tendency - shallow convection rainout'                   )
         209           0 :   call addfld( 'EVAPTCM',    (/ 'lev' /),  'A', 'K/s',      'T tendency - Evaporation/snow prod from Hack convection'   )
         210           0 :   call addfld( 'FZSNTCM',    (/ 'lev' /),  'A', 'K/s',      'T tendency - Rain to snow conversion from Hack convection' )
         211           0 :   call addfld( 'EVSNTCM',    (/ 'lev' /),  'A', 'K/s',      'T tendency - Snow to rain prod from Hack convection'       )
         212           0 :   call addfld( 'EVAPQCM',    (/ 'lev' /),  'A', 'kg/kg/s',  'Q tendency - Evaporation from Hack convection'             )
         213           0 :   call addfld( 'QC',         (/ 'lev' /),  'A', 'kg/kg/s',  'Q tendency - shallow convection LW export'                 )
         214           0 :   call addfld( 'PRECSH',     horiz_only,   'A', 'm/s',      'Shallow Convection precipitation rate'                     )
         215           0 :   call addfld( 'CMFMC',      (/ 'ilev' /), 'A', 'kg/m2/s',  'Moist convection (deep+shallow) mass flux'                 )
         216           0 :   call addfld( 'CMFSL',      (/ 'ilev' /), 'A', 'W/m2',     'Moist shallow convection liquid water static energy flux'  )
         217           0 :   call addfld( 'CMFLQ',      (/ 'ilev' /), 'A', 'W/m2',     'Moist shallow convection total water flux'                 )
         218           0 :   call addfld ('DQP',        (/ 'lev' /),  'A', 'kg/kg/s',  'Specific humidity tendency due to precipitation'           )
         219           0 :   call addfld( 'CBMF',       horiz_only,   'A', 'kg/m2/s',  'Cloud base mass flux'                                      )
         220           0 :   call addfld( 'CLDTOP',     horiz_only,   'I', '1',        'Vertical index of cloud top'                               )
         221           0 :   call addfld( 'CLDBOT',     horiz_only,   'I', '1',        'Vertical index of cloud base'                              )
         222           0 :   call addfld( 'PCLDTOP',    horiz_only,   'A', '1',        'Pressure of cloud top'                                     )
         223           0 :   call addfld( 'PCLDBOT',    horiz_only,   'A', '1',        'Pressure of cloud base'                                    )
         224             :
         225           0 :   call addfld( 'FREQSH',     horiz_only,   'A', 'fraction', 'Fractional occurance of shallow convection'                )
         226             :
         227           0 :   call addfld( 'HKFLXPRC',   (/ 'ilev' /), 'A', 'kg/m2/s',  'Flux of precipitation from HK convection'                  )
         228           0 :   call addfld( 'HKFLXSNW',   (/ 'ilev' /), 'A', 'kg/m2/s',  'Flux of snow from HK convection'                           )
         229           0 :   call addfld( 'HKNTPRPD',   (/ 'lev' /),  'A', 'kg/kg/s',  'Net precipitation production from HK convection'           )
         230           0 :   call addfld( 'HKNTSNPD',   (/ 'lev' /),  'A', 'kg/kg/s',  'Net snow production from HK convection'                    )
         231           0 :   call addfld( 'HKEIHEAT',   (/ 'lev' /),  'A', 'W/kg',     'Heating by ice and evaporation in HK convection'           )
         232             :
         233           0 :   call addfld ('ICWMRSH',    (/ 'lev' /),  'A', 'kg/kg',    'Shallow Convection in-cloud water mixing ratio '           )
         234             :
         235           0 :   if( shallow_scheme .eq. 'UW' ) then
         236           0 :      call addfld( 'UWFLXPRC',  (/ 'ilev' /),  'A', 'kg/m2/s', 'Flux of precipitation from UW shallow convection' )
         237           0 :      call addfld( 'UWFLXSNW',  (/ 'ilev' /),  'A', 'kg/m2/s', 'Flux of snow from UW shallow convection'          )
         238             :   end if
         239             :
         240             :
         241             :
         242             :   call phys_getopts( eddy_scheme_out = eddy_scheme      , &
         243             :                      history_amwg_out = history_amwg    , &
         244             :                      history_budget_out = history_budget, &
         245           0 :                      history_budget_histfile_num_out = history_budget_histfile_num)
         246             :
         247             :
         248           0 :   if( history_budget ) then
         249           0 :       call add_default( 'CMFDLIQ  ', history_budget_histfile_num, ' ' )
         250           0 :       call add_default( 'CMFDICE  ', history_budget_histfile_num, ' ' )
         251           0 :       call add_default( 'CMFDT   ', history_budget_histfile_num, ' ' )
         252           0 :       call add_default( 'CMFDQ   ', history_budget_histfile_num, ' ' )
         253           0 :       if( cam_physpkg_is('cam4') ) then
         254           0 :          call add_default( 'EVAPQCM  ', history_budget_histfile_num, ' ' )
         255           0 :          call add_default( 'EVAPTCM  ', history_budget_histfile_num, ' ' )
         256             :       end if
         257             :   end if
         258           0 :   pblh_idx  = pbuf_get_index('pblh')
         259             :
         260             :
         261           0 :   select case (shallow_scheme)
         262             :
         263             :   case('off')  ! None
         264             :
         265           0 :      if( masterproc ) write(iulog,*) 'convect_shallow_init: shallow convection OFF'
         266           0 :      continue
         267             :
         268             :   case('Hack') ! Hack scheme
         269             :
         270           0 :      qpert_idx = pbuf_get_index('qpert')
         271             :
         272           0 :      if( masterproc ) write(iulog,*) 'convect_shallow_init: Hack shallow convection'
         273             :    ! Limit shallow convection to regions below 40 mb
         274             :    ! Note this calculation is repeated in the deep convection interface
         275           0 :      if( pref_edge(1) >= 4.e3_r8 ) then
         276           0 :          limcnv = 1
         277             :      else
         278           0 :          do k = 1, plev
         279           0 :             if( pref_edge(k) < 4.e3_r8 .and. pref_edge(k+1) >= 4.e3_r8 ) then
         280           0 :                 limcnv = k
         281           0 :                 goto 10
         282             :             end if
         283             :          end do
         284           0 :          limcnv = plevp
         285             :      end if
         286             : 10   continue
         287             :
         288           0 :      if( masterproc ) then
         289           0 :          write(iulog,*) 'MFINTI: Convection will be capped at intfc ', limcnv, ' which is ', pref_edge(limcnv), ' pascals'
         290             :      end if
         291             :
         292           0 :      call mfinti( rair, cpair, gravit, latvap, rhoh2o, limcnv) ! Get args from inti.F90
         293             :
         294             :   case('UW') ! Park and Bretherton shallow convection scheme
         295             :
         296           0 :      if( masterproc ) write(iulog,*) 'convect_shallow_init: UW shallow convection scheme (McCaa)'
         297           0 :      if( eddy_scheme .ne. 'diag_TKE' ) then
         298           0 :          write(iulog,*) 'ERROR: shallow convection scheme ', shallow_scheme, ' is incompatible with eddy scheme ', eddy_scheme
         299           0 :          call endrun( 'convect_shallow_init: shallow_scheme and eddy_scheme are incompatible' )
         300             :      endif
         301           0 :      call init_uwshcu( r8, latvap, cpair, latice, zvir, rair, gravit, mwh2o/mwdry )
         302             :
         303           0 :      tke_idx = pbuf_get_index('tke')
         304             :
         305             :   case('UNICON') ! Sungsu Park's General Convection Model
         306             :
         307           0 :      if ( masterproc ) write(iulog,*) 'convect_shallow_init: General Convection Model by Sungsu Park'
         308           0 :      if ( eddy_scheme .ne. 'diag_TKE' ) then
         309           0 :           write(iulog,*)  eddy_scheme
         310           0 :           write(iulog,*) 'ERROR: shallow convection scheme ',shallow_scheme,' is incompatible with eddy scheme ', eddy_scheme
         311           0 :           call endrun( 'convect_shallow_init: shallow_scheme and eddy_scheme are incompatible' )
         312             :      endif
         313           0 :      call unicon_cam_init(pbuf2d)
         314             :
         315             :   end select
         316             :
         317           0 :   cld_idx      = pbuf_get_index('CLD')
         318           0 :   concld_idx   = pbuf_get_index('CONCLD')
         319           0 :   rprddp_idx   = pbuf_get_index('RPRDDP')
         320             :
         321           0 :   call pbuf_set_field(pbuf2d, sh_flxprc_idx, 0._r8)
         322           0 :   call pbuf_set_field(pbuf2d, sh_flxsnw_idx, 0._r8)
         323             :
         324           0 :   end subroutine convect_shallow_init
         325             :
         326             : !==================================================================================================
         327             :
         328           0 :   function convect_shallow_use_shfrc()
         329             :   !-------------------------------------------------------------- !
         330             :   ! Return true if cloud fraction should use shallow convection   !
         331             :   !          calculated convective clouds.                        !
         332             :   !-------------------------------------------------------------- !
         333             :      implicit none
         334             :      logical :: convect_shallow_use_shfrc     ! Return value
         335             :
         336           0 :      if (shallow_scheme .eq. 'UW' .or. shallow_scheme .eq. 'UNICON') then
         337             :           convect_shallow_use_shfrc = .true.
         338             :      else
         339           0 :           convect_shallow_use_shfrc = .false.
         340             :      endif
         341             :
         342             :      return
         343             :
         344           0 :   end function convect_shallow_use_shfrc
         345             :
         346             :   !=============================================================================== !
         347             :   !                                                                                !
         348             :   !=============================================================================== !
         349             :
         350           0 :   subroutine convect_shallow_tend( ztodt  , cmfmc   , &
         351             :                                    qc     , qc2     , rliq     , rliq2    , &
         352             :                                    state  , ptend_all, pbuf, cam_in)
         353             :
         354             :    use physics_buffer,  only : physics_buffer_desc, pbuf_get_field, pbuf_set_field, pbuf_old_tim_idx
         355             :    use cam_history,     only : outfld
         356             :    use physics_types,   only : physics_state, physics_ptend
         357             :    use physics_types,   only : physics_ptend_init, physics_update
         358             :    use physics_types,   only : physics_state_copy, physics_state_dealloc
         359             :    use physics_types,   only : physics_ptend_dealloc
         360             :    use physics_types,   only : physics_ptend_sum
         361             :    use camsrfexch,      only : cam_in_t
         362             :
         363             :    use constituents,    only : pcnst, cnst_get_ind, cnst_get_type_byind
         364             :    use hk_conv,         only : cmfmca
         365             :    use uwshcu,          only : compute_uwshcu_inv
         366             :    use unicon_cam,      only : unicon_out_t, unicon_cam_tend
         367             :
         368             :    use time_manager,    only : get_nstep
         369             :    use wv_saturation,   only : qsat
         370             :    use physconst,       only : latice, latvap, rhoh2o, tmelt, gravit
         371             :
         372             :    use spmd_utils, only : iam
         373             :    implicit none
         374             :
         375             :    ! ---------------------- !
         376             :    ! Input-Output Arguments !
         377             :    ! ---------------------- !
         378             :    type(physics_buffer_desc), pointer :: pbuf(:)
         379             :    type(physics_state), intent(in)    :: state                           ! Physics state variables
         380             :    real(r8),            intent(in)    :: ztodt                           ! 2 delta-t  [ s ]
         381             :
         382             :    type(physics_ptend), intent(out)   :: ptend_all                       ! Indivdual parameterization tendencies
         383             :    real(r8),            intent(out)   :: rliq2(pcols)                    ! Vertically-integrated reserved cloud condensate [ m/s ]
         384             :    real(r8),            intent(out)   :: qc2(pcols,pver)                 ! Same as qc but only from shallow convection scheme
         385             :
         386             :
         387             :
         388             :    real(r8),            intent(inout) :: cmfmc(pcols,pverp)    ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ]
         389             :    real(r8),            intent(inout) :: qc(pcols,pver)        ! dq/dt due to export of cloud water into environment by shallow
         390             :                                                                ! and deep convection [ kg/kg/s ]
         391             :    real(r8),            intent(inout) :: rliq(pcols)           ! Vertical integral of qc [ m/s ]
         392             :
         393             :    type(cam_in_t),      intent(in) :: cam_in
         394             :
         395             :
         396             :    ! --------------- !
         397             :    ! Local Variables !
         398             :    ! --------------- !
         399             :    integer  :: i, k, m
         400             :    integer  :: n, x
         401             :    integer  :: ilon                                                      ! Global longitude index of a column
         402             :    integer  :: ilat                                                      ! Global latitude  index of a column
         403             :    integer  :: lchnk                                                     ! Chunk identifier
         404             :    integer  :: ncol                                                      ! Number of atmospheric columns
         405             :    integer  :: nstep                                                     ! Current time step index
         406             :    integer  :: ixcldice, ixcldliq                                        ! Constituent indices for cloud liquid and ice water.
         407             :    integer  :: ixnumice, ixnumliq                                        ! Constituent indices for cloud liquid and ice number concentration
         408             :
         409           0 :    real(r8),  pointer   :: precc(:)                                      ! Shallow convective precipitation (rain+snow) rate at surface [ m/s ]
         410           0 :    real(r8),  pointer   :: snow(:)                                       ! Shallow convective snow rate at surface [ m/s ]
         411             :
         412             :    real(r8) :: ftem(pcols,pver)                                          ! Temporary workspace for outfld variables
         413             :    real(r8) :: cnt2(pcols)                                               ! Top level of shallow convective activity
         414             :    real(r8) :: cnb2(pcols)                                               ! Bottom level of convective activity
         415             :    real(r8) :: tpert(pcols)                                              ! PBL perturbation theta
         416             :
         417           0 :    real(r8), pointer   :: pblh(:)                                        ! PBL height [ m ]
         418           0 :    real(r8), pointer   :: qpert(:,:)                                     ! PBL perturbation specific humidity
         419             :
         420             :    ! Temperature tendency from shallow convection (pbuf pointer).
         421           0 :    real(r8), pointer, dimension(:,:) :: ttend_sh
         422             :
         423             :    real(r8) :: ntprprd(pcols,pver)                                       ! Net precip production in layer
         424             :    real(r8) :: ntsnprd(pcols,pver)                                       ! Net snow   production in layer
         425             :    real(r8) :: tend_s_snwprd(pcols,pver)                                 ! Heating rate of snow production
         426             :    real(r8) :: tend_s_snwevmlt(pcols,pver)                               ! Heating rate of evap/melting of snow
         427             :    real(r8) :: slflx(pcols,pverp)                                        ! Shallow convective liquid water static energy flux
         428             :    real(r8) :: qtflx(pcols,pverp)                                        ! Shallow convective total water flux
         429             :    real(r8) :: cmfdqs(pcols, pver)                                       ! Shallow convective snow production
         430             :    real(r8) :: zero(pcols)                                               ! Array of zeros
         431             :    real(r8) :: cbmf(pcols)                                               ! Shallow cloud base mass flux [ kg/s/m2 ]
         432             :    real(r8) :: freqsh(pcols)                                             ! Frequency of shallow convection occurence
         433             :    real(r8) :: pcnt(pcols)                                               ! Top    pressure level of shallow + deep convective activity
         434             :    real(r8) :: pcnb(pcols)                                               ! Bottom pressure level of shallow + deep convective activity
         435             :    real(r8) :: cmfsl(pcols,pverp )                                       ! Convective flux of liquid water static energy
         436             :    real(r8) :: cmflq(pcols,pverp )                                       ! Convective flux of total water in energy unit
         437             :
         438             :    real(r8) :: ftem_preCu(pcols,pver)                                    ! Saturation vapor pressure after shallow Cu convection
         439             :    real(r8) :: tem2(pcols,pver)                                          ! Saturation specific humidity and RH
         440             :    real(r8) :: t_preCu(pcols,pver)                                       ! Temperature after shallow Cu convection
         441             :    real(r8) :: tten(pcols,pver)                                          ! Temperature tendency after shallow Cu convection
         442             :    real(r8) :: rhten(pcols,pver)                                         ! RH tendency after shallow Cu convection
         443             :    real(r8) :: iccmr_UW(pcols,pver)                                      ! In-cloud Cumulus LWC+IWC [ kg/m2 ]
         444             :    real(r8) :: icwmr_UW(pcols,pver)                                      ! In-cloud Cumulus LWC     [ kg/m2 ]
         445             :    real(r8) :: icimr_UW(pcols,pver)                                      ! In-cloud Cumulus IWC     [ kg/m2 ]
         446             :    real(r8) :: ptend_tracer(pcols,pver,pcnst)                            ! Tendencies of tracers
         447             :    real(r8) :: sum1, sum2, sum3, pdelx
         448             :    real(r8) :: landfracdum(pcols)
         449             :
         450             :    real(r8), dimension(pcols,pver) :: sl, qt, slv
         451             :    real(r8), dimension(pcols,pver) :: sl_preCu, qt_preCu, slv_preCu
         452             :
         453           0 :    type(physics_state) :: state1                                         ! Locally modify for evaporation to use, not returned
         454           0 :    type(physics_ptend) :: ptend_loc                                      ! Local tendency from processes, added up to return as ptend_all
         455             :
         456             :    integer itim_old, ifld
         457           0 :    real(r8), pointer, dimension(:,:) :: cld
         458           0 :    real(r8), pointer, dimension(:,:) :: concld
         459           0 :    real(r8), pointer, dimension(:,:) :: icwmr                            ! In cloud water + ice mixing ratio
         460           0 :    real(r8), pointer, dimension(:,:) :: rprddp                           ! dq/dt due to deep convective rainout
         461           0 :    real(r8), pointer, dimension(:,:) :: rprdsh                           ! dq/dt due to deep and shallow convective rainout
         462           0 :    real(r8), pointer, dimension(:,:) :: evapcsh                          ! Evaporation of shallow convective precipitation >= 0.
         463           0 :    real(r8), pointer, dimension(:)   :: cnt
         464           0 :    real(r8), pointer, dimension(:)   :: cnb
         465           0 :    real(r8), pointer, dimension(:)   :: cush
         466           0 :    real(r8), pointer, dimension(:,:) :: tke
         467           0 :    real(r8), pointer, dimension(:,:) :: shfrc
         468           0 :    real(r8), pointer, dimension(:,:) :: flxprec                          ! Shallow convective-scale flux of precip (rain+snow) at interfaces [ kg/m2/s ]
         469           0 :    real(r8), pointer, dimension(:,:) :: flxsnow                          ! Shallow convective-scale flux of snow at interfaces [ kg/m2/s ]
         470           0 :    real(r8), pointer, dimension(:,:) :: sh_cldliq
         471           0 :    real(r8), pointer, dimension(:,:) :: sh_cldice
         472             :
         473           0 :    real(r8), pointer, dimension(:,:) :: cmfmc2              ! (pcols,pverp) Updraft mass flux by shallow convection [ kg/s/m2 ]
         474           0 :    real(r8), pointer, dimension(:,:) :: sh_e_ed_ratio       ! (pcols,pver) fer/(fer+fdr) from uwschu
         475             :
         476             :    logical                           :: lq(pcnst)
         477             :
         478             :    type(unicon_out_t) :: unicon_out
         479             :
         480             :    ! ----------------------- !
         481             :    ! Main Computation Begins !
         482             :    ! ----------------------- !
         483             :
         484           0 :    zero  = 0._r8
         485           0 :    nstep = get_nstep()
         486           0 :    lchnk = state%lchnk
         487           0 :    ncol  = state%ncol
         488             :
         489           0 :    call physics_state_copy( state, state1 )          ! Copy state to local state1.
         490             :
         491             :    ! Associate pointers with physics buffer fields
         492             :
         493             :
         494           0 :    itim_old   =  pbuf_old_tim_idx()
         495           0 :    call pbuf_get_field(pbuf, cld_idx,         cld,    start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
         496           0 :    call pbuf_get_field(pbuf, concld_idx,      concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
         497             :
         498           0 :    call pbuf_get_field(pbuf, icwmrsh_idx,     icwmr)
         499             :
         500           0 :    call pbuf_get_field(pbuf, rprddp_idx,      rprddp )
         501             :
         502           0 :    call pbuf_get_field(pbuf, rprdsh_idx,      rprdsh )
         503             :
         504           0 :    call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh  )
         505             :
         506           0 :    call pbuf_get_field(pbuf, cldtop_idx,      cnt )
         507             :
         508           0 :    call pbuf_get_field(pbuf, cldbot_idx,      cnb )
         509             :
         510           0 :    call pbuf_get_field(pbuf, prec_sh_idx,   precc )
         511             :
         512           0 :    call pbuf_get_field(pbuf, snow_sh_idx,    snow )
         513             :
         514           0 :    if( convect_shallow_use_shfrc() ) then
         515           0 :        call pbuf_get_field(pbuf, shfrc_idx,  shfrc  )
         516             :    endif
         517             :
         518           0 :    call pbuf_get_field(pbuf, cmfmc_sh_idx,  cmfmc2)
         519             :
         520             :    ! Initialization
         521             :
         522             :
         523           0 :    call cnst_get_ind( 'CLDLIQ', ixcldliq )
         524           0 :    call cnst_get_ind( 'CLDICE', ixcldice )
         525             :
         526           0 :    call pbuf_get_field(pbuf, pblh_idx, pblh)
         527             :
         528             :    !  This field probably should reference the pbuf tpert field but it doesnt
         529           0 :    tpert(:ncol)         = 0._r8
         530           0 :    landfracdum(:ncol)   = 0._r8
         531             :
         532             :    select case (shallow_scheme)
         533             :
         534             :    case('off', 'CLUBB_SGS') ! None
         535             :
         536           0 :       lq(:) = .TRUE.
         537           0 :       call physics_ptend_init( ptend_loc, state%psetcols, 'convect_shallow (off)', ls=.true., lq=lq ) ! Initialize local ptend type
         538             :
         539           0 :       cmfmc2      = 0._r8
         540           0 :       ptend_loc%q = 0._r8
         541           0 :       ptend_loc%s = 0._r8
         542           0 :       rprdsh      = 0._r8
         543           0 :       cmfdqs      = 0._r8
         544           0 :       precc       = 0._r8
         545           0 :       slflx       = 0._r8
         546           0 :       qtflx       = 0._r8
         547           0 :       icwmr       = 0._r8
         548           0 :       rliq2       = 0._r8
         549           0 :       qc2         = 0._r8
         550           0 :       cmfsl       = 0._r8
         551           0 :       cmflq       = 0._r8
         552           0 :       cnt2        = pver
         553           0 :       cnb2        = 1._r8
         554           0 :       evapcsh     = 0._r8
         555           0 :       snow        = 0._r8
         556             :
         557             :    case('Hack') ! Hack scheme
         558             :
         559           0 :       lq(:) = .TRUE.
         560           0 :       call physics_ptend_init( ptend_loc, state%psetcols, 'cmfmca', ls=.true., lq=lq  ) ! Initialize local ptend type
         561             :
         562           0 :       call pbuf_get_field(pbuf, qpert_idx, qpert)
         563           0 :       qpert(:ncol,2:pcnst) = 0._r8
         564             :
         565             :       call cmfmca( lchnk        ,  ncol         ,                                               &
         566             :                    nstep        ,  ztodt        ,  state%pmid ,  state%pdel  ,                  &
         567             :                    state%rpdel  ,  state%zm     ,  tpert      ,  qpert       ,  state%phis  ,   &
         568             :                    pblh         ,  state%t      ,  state%q    ,  ptend_loc%s ,  ptend_loc%q ,   &
         569             :                    cmfmc2       ,  rprdsh       ,  cmfsl      ,  cmflq       ,  precc       ,   &
         570             :                    qc2          ,  cnt2         ,  cnb2       ,  icwmr       ,  rliq2       ,   &
         571           0 :                    state%pmiddry,  state%pdeldry,  state%rpdeldry )
         572             :
         573             :    case('UW')   ! UW shallow convection scheme
         574             :
         575             :       ! -------------------------------------- !
         576             :       ! uwshcu does momentum transport as well !
         577             :       ! -------------------------------------- !
         578             :
         579             :       ! Initialize local ptend type
         580           0 :       lq(:) = .TRUE.
         581           0 :       call physics_ptend_init( ptend_loc, state%psetcols, 'UWSHCU', ls=.true., lu=.true., lv=.true., lq=lq  )
         582             :
         583           0 :       call pbuf_get_field(pbuf, cush_idx, cush  ,(/1,itim_old/),  (/pcols,1/))
         584           0 :       call pbuf_get_field(pbuf, tke_idx,  tke)
         585             :
         586             :
         587           0 :       call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec)
         588           0 :       call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow)
         589           0 :       call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio)
         590             :
         591             :       call compute_uwshcu_inv( pcols     , pver    , ncol           , pcnst         , ztodt         ,                   &
         592             :                                state%pint, state%zi, state%pmid     , state%zm      , state%pdel    ,                   &
         593             :                                state%u   , state%v , state%q(:,:,1) , state%q(:,:,ixcldliq), state%q(:,:,ixcldice),     &
         594             :                                state%t   , state%s , state%q(:,:,:) ,                                                   &
         595             :                                tke       , cld     , concld         , pblh          , cush          ,                   &
         596             :                                cmfmc2    , slflx   , qtflx          ,                                                   &
         597             :                                flxprec, flxsnow,                                                                        &
         598             :                                ptend_loc%q(:,:,1)  , ptend_loc%q(:,:,ixcldliq), ptend_loc%q(:,:,ixcldice),              &
         599             :                                ptend_loc%s         , ptend_loc%u    , ptend_loc%v   , ptend_tracer  ,                   &
         600             :                                rprdsh              , cmfdqs         , precc         , snow          ,                   &
         601             :                                evapcsh             , shfrc          , iccmr_UW      , icwmr_UW      ,                   &
         602             :                                icimr_UW            , cbmf           , qc2           , rliq2         ,                   &
         603             :                                cnt2                , cnb2           , lchnk         , state%pdeldry ,                   &
         604           0 :                                sh_e_ed_ratio                                                                            )
         605             :
         606             :       ! --------------------------------------------------------------------- !
         607             :       ! Here, 'rprdsh = qrten', 'cmfdqs = qsten' both in unit of [ kg/kg/s ]  !
         608             :       ! In addition, define 'icwmr' which includes both liquid and ice.       !
         609             :       ! --------------------------------------------------------------------- !
         610             :
         611           0 :       icwmr(:ncol,:)  = iccmr_UW(:ncol,:)
         612           0 :       rprdsh(:ncol,:) = rprdsh(:ncol,:) + cmfdqs(:ncol,:)
         613           0 :       do m = 4, pcnst
         614           0 :          ptend_loc%q(:ncol,:pver,m) = ptend_tracer(:ncol,:pver,m)
         615             :       enddo
         616             :
         617             :       ! Conservation check
         618             :
         619             :       !  do i = 1, ncol
         620             :       !  do m = 1, pcnst
         621             :       !     sum1 = 0._r8
         622             :       !     sum2 = 0._r8
         623             :       !     sum3 = 0._r8
         624             :       !  do k = 1, pver
         625             :       !       if(cnst_get_type_byind(m).eq.'wet') then
         626             :       !          pdelx = state%pdel(i,k)
         627             :       !       else
         628             :       !          pdelx = state%pdeldry(i,k)
         629             :       !       endif
         630             :       !       sum1 = sum1 + state%q(i,k,m)*pdelx
         631             :       !       sum2 = sum2 +(state%q(i,k,m)+ptend_loc%q(i,k,m)*ztodt)*pdelx
         632             :       !       sum3 = sum3 + ptend_loc%q(i,k,m)*pdelx
         633             :       !  enddo
         634             :       !  if( m .gt. 3 .and. abs(sum1) .gt. 1.e-13_r8 .and. abs(sum2-sum1)/sum1 .gt. 1.e-12_r8 ) then
         635             :       !! if( m .gt. 3 .and. abs(sum3) .gt. 1.e-13_r8 ) then
         636             :       !      write(iulog,*) 'Sungsu : convect_shallow.F90 does not conserve tracers : ', m, sum1, sum2, abs(sum2-sum1)/sum1
         637             :       !!     write(iulog,*) 'Sungsu : convect_shallow.F90 does not conserve tracers : ', m, sum3
         638             :       !  endif
         639             :       !  enddo
         640             :       !  enddo
         641             :
         642             :       ! ------------------------------------------------- !
         643             :       ! Convective fluxes of 'sl' and 'qt' in energy unit !
         644             :       ! ------------------------------------------------- !
         645             :
         646           0 :       cmfsl(:ncol,:) = slflx(:ncol,:)
         647           0 :       cmflq(:ncol,:) = qtflx(:ncol,:) * latvap
         648             :
         649           0 :       call outfld( 'PRECSH' , precc  , pcols, lchnk )
         650             :
         651             :
         652             :    case('UNICON')
         653             :
         654           0 :       icwmr = 0.0_r8
         655             :
         656             :       call unicon_cam_tend(ztodt, state, cam_in, &
         657           0 :                            pbuf, ptend_loc, unicon_out)
         658             :
         659           0 :       cmfmc2(:ncol,:) = unicon_out%cmfmc(:ncol,:)
         660           0 :       qc2(:ncol,:)    = unicon_out%rqc(:ncol,:)
         661           0 :       rliq2(:ncol)    = unicon_out%rliq(:ncol)
         662           0 :       cnt2(:ncol)     = unicon_out%cnt(:ncol)
         663           0 :       cnb2(:ncol)     = unicon_out%cnb(:ncol)
         664             :
         665             :       ! ------------------------------------------------- !
         666             :       ! Convective fluxes of 'sl' and 'qt' in energy unit !
         667             :       ! ------------------------------------------------- !
         668             :
         669           0 :       cmfsl(:ncol,:) = unicon_out%slflx(:ncol,:)
         670           0 :       cmflq(:ncol,:) = unicon_out%qtflx(:ncol,:) * latvap
         671             :
         672           0 :       call outfld( 'PRECSH' , precc  , pcols, lchnk )
         673             :
         674             :    end select
         675             :
         676             :    ! --------------------------------------------------------!
         677             :    ! Calculate fractional occurance of shallow convection    !
         678             :    ! --------------------------------------------------------!
         679             :
         680             :  ! Modification : I should check whether below computation of freqsh is correct.
         681             :
         682           0 :    freqsh(:) = 0._r8
         683           0 :    do i = 1, ncol
         684           0 :       if( maxval(cmfmc2(i,:pver)) <= 0._r8 ) then
         685           0 :           freqsh(i) = 1._r8
         686             :       end if
         687             :    end do
         688             :
         689             :    ! ------------------------------------------------------------------------------ !
         690             :    ! Merge shallow convection output with prior results from deep convection scheme !
         691             :    ! ------------------------------------------------------------------------------ !
         692             :
         693             :    ! ----------------------------------------------------------------------- !
         694             :    ! Combine cumulus updraft mass flux : 'cmfmc2'(shallow) + 'cmfmc'(deep)   !
         695             :    ! ----------------------------------------------------------------------- !
         696             :
         697           0 :    cmfmc(:ncol,:) = cmfmc(:ncol,:) + cmfmc2(:ncol,:)
         698             :
         699             :    ! -------------------------------------------------------------- !
         700             :    ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep  !
         701             :    ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: !
         702             :    !        cnt2 = float(kpen)                                      !
         703             :    !        cnb2 = float(krel - 1)                                  !
         704             :    ! Note that indices decreases with height.                       !
         705             :    ! -------------------------------------------------------------- !
         706             :
         707           0 :    do i = 1, ncol
         708           0 :       if( cnt2(i) < cnt(i)) cnt(i) = cnt2(i)
         709           0 :       if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i)
         710           0 :       if( cnb(i) == 1._r8 ) cnb(i) = cnt(i)
         711           0 :       pcnt(i) = state%pmid(i,int(cnt(i)))
         712           0 :       pcnb(i) = state%pmid(i,int(cnb(i)))
         713             :    end do
         714             :
         715             :    ! ----------------------------------------------- !
         716             :    ! This quantity was previously known as CMFDQR.   !
         717             :    ! Now CMFDQR is the shallow rain production only. !
         718             :    ! ----------------------------------------------- !
         719             :
         720             :
         721           0 :    call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/))
         722             :
         723             :    ! ----------------------------------------------------------------------- !
         724             :    ! Add shallow reserved cloud condensate to deep reserved cloud condensate !
         725             :    !     qc [ kg/kg/s] , rliq [ m/s ]                                        !
         726             :    ! ----------------------------------------------------------------------- !
         727             :
         728           0 :    qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver)
         729           0 :    rliq(:ncol)     = rliq(:ncol) + rliq2(:ncol)
         730             :
         731             :    ! ---------------------------------------------------------------------------- !
         732             :    ! Output new partition of cloud condensate variables, as well as precipitation !
         733             :    ! ---------------------------------------------------------------------------- !
         734             :
         735           0 :    if( microp_scheme == 'MG' ) then
         736           0 :        call cnst_get_ind( 'NUMLIQ', ixnumliq )
         737           0 :        call cnst_get_ind( 'NUMICE', ixnumice )
         738             :    endif
         739             :
         740           0 :    ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair
         741             :
         742           0 :    call outfld( 'ICWMRSH ', icwmr                    , pcols   , lchnk )
         743             :
         744           0 :    call outfld( 'CMFDT  ', ftem                      , pcols   , lchnk )
         745           0 :    call outfld( 'CMFDQ  ', ptend_loc%q(1,1,1)        , pcols   , lchnk )
         746           0 :    call outfld( 'CMFDICE', ptend_loc%q(1,1,ixcldice) , pcols   , lchnk )
         747           0 :    call outfld( 'CMFDLIQ', ptend_loc%q(1,1,ixcldliq) , pcols   , lchnk )
         748           0 :    call outfld( 'CMFMC'  , cmfmc                     , pcols   , lchnk )
         749           0 :    call outfld( 'QC'     , qc2                       , pcols   , lchnk )
         750           0 :    call outfld( 'CMFDQR' , rprdsh                    , pcols   , lchnk )
         751           0 :    call outfld( 'CMFSL'  , cmfsl                     , pcols   , lchnk )
         752           0 :    call outfld( 'CMFLQ'  , cmflq                     , pcols   , lchnk )
         753           0 :    call outfld( 'DQP'    , qc2                       , pcols   , lchnk )
         754           0 :    call outfld( 'CLDTOP' , cnt                       , pcols   , lchnk )
         755           0 :    call outfld( 'CLDBOT' , cnb                       , pcols   , lchnk )
         756           0 :    call outfld( 'PCLDTOP', pcnt                      , pcols   , lchnk )
         757           0 :    call outfld( 'PCLDBOT', pcnb                      , pcols   , lchnk )
         758           0 :    call outfld( 'FREQSH' , freqsh                    , pcols   , lchnk )
         759             :
         760           0 :    if( shallow_scheme .eq. 'UW' ) then
         761           0 :       call outfld( 'CBMF'   , cbmf                      , pcols   , lchnk )
         762           0 :       call outfld( 'UWFLXPRC', flxprec                  , pcols   , lchnk )
         763           0 :       call outfld( 'UWFLXSNW' , flxsnow                 , pcols   , lchnk )
         764             :    endif
         765             :
         766             :    ! ---------------------------------------------------------------- !
         767             :    ! Add tendency from this process to tend from other processes here !
         768             :    ! ---------------------------------------------------------------- !
         769             :
         770           0 :    call physics_ptend_init(ptend_all, state1%psetcols, 'convect_shallow')
         771           0 :    call physics_ptend_sum( ptend_loc, ptend_all, ncol )
         772             :
         773             :    ! ----------------------------------------------------------------------------- !
         774             :    ! For diagnostic purpose, print out 'QT,SL,SLV,T,RH' just before cumulus scheme !
         775             :    ! ----------------------------------------------------------------------------- !
         776             :
         777           0 :    sl_preCu(:ncol,:pver)  = state1%s(:ncol,:pver) -   latvap           * state1%q(:ncol,:pver,ixcldliq) &
         778           0 :                                                   - ( latvap + latice) * state1%q(:ncol,:pver,ixcldice)
         779           0 :    qt_preCu(:ncol,:pver)  = state1%q(:ncol,:pver,1) + state1%q(:ncol,:pver,ixcldliq) &
         780           0 :                                                     + state1%q(:ncol,:pver,ixcldice)
         781           0 :    slv_preCu(:ncol,:pver) = sl_preCu(:ncol,:pver) * ( 1._r8 + zvir * qt_preCu(:ncol,:pver) )
         782             :
         783           0 :    t_preCu(:ncol,:)       = state1%t(:ncol,:pver)
         784           0 :    do k = 1, pver
         785           0 :       call qsat(state1%t(1:ncol,k), state1%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol)
         786             :    end do
         787           0 :    ftem_preCu(:ncol,:)    = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8
         788             :
         789           0 :    call outfld( 'qt_pre_Cu      ', qt_preCu               , pcols, lchnk )
         790           0 :    call outfld( 'sl_pre_Cu      ', sl_preCu               , pcols, lchnk )
         791           0 :    call outfld( 'slv_pre_Cu     ', slv_preCu              , pcols, lchnk )
         792           0 :    call outfld( 'u_pre_Cu       ', state1%u               , pcols, lchnk )
         793           0 :    call outfld( 'v_pre_Cu       ', state1%v               , pcols, lchnk )
         794           0 :    call outfld( 'qv_pre_Cu      ', state1%q(:,:,1)        , pcols, lchnk )
         795           0 :    call outfld( 'ql_pre_Cu      ', state1%q(:,:,ixcldliq) , pcols, lchnk )
         796           0 :    call outfld( 'qi_pre_Cu      ', state1%q(:,:,ixcldice) , pcols, lchnk )
         797           0 :    call outfld( 't_pre_Cu       ', state1%t               , pcols, lchnk )
         798           0 :    call outfld( 'rh_pre_Cu      ', ftem_preCu             , pcols, lchnk )
         799             :
         800             :    ! ----------------------------------------------- !
         801             :    ! Update physics state type state1 with ptend_loc !
         802             :    ! ----------------------------------------------- !
         803             :
         804           0 :    call physics_update( state1, ptend_loc, ztodt )
         805             :
         806             :    ! ----------------------------------------------------------------------------- !
         807             :    ! For diagnostic purpose, print out 'QT,SL,SLV,t,RH' just after cumulus scheme  !
         808             :    ! ----------------------------------------------------------------------------- !
         809             :
         810           0 :    sl(:ncol,:pver)  = state1%s(:ncol,:pver) -   latvap           * state1%q(:ncol,:pver,ixcldliq) &
         811           0 :                                             - ( latvap + latice) * state1%q(:ncol,:pver,ixcldice)
         812           0 :    qt(:ncol,:pver)  = state1%q(:ncol,:pver,1) + state1%q(:ncol,:pver,ixcldliq) &
         813           0 :                                               + state1%q(:ncol,:pver,ixcldice)
         814           0 :    slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir * qt(:ncol,:pver) )
         815             :
         816           0 :    do k = 1, pver
         817           0 :       call qsat(state1%t(1:ncol,k), state1%pmid(1:ncol,k), tem2(1:ncol,k), ftem(1:ncol,k), ncol)
         818             :    end do
         819           0 :    ftem(:ncol,:)    = state1%q(:ncol,:,1) / ftem(:ncol,:) * 100._r8
         820             :
         821           0 :    call outfld( 'qt_aft_Cu      ', qt                     , pcols, lchnk )
         822           0 :    call outfld( 'sl_aft_Cu      ', sl                     , pcols, lchnk )
         823           0 :    call outfld( 'slv_aft_Cu     ', slv                    , pcols, lchnk )
         824           0 :    call outfld( 'u_aft_Cu       ', state1%u               , pcols, lchnk )
         825           0 :    call outfld( 'v_aft_Cu       ', state1%v               , pcols, lchnk )
         826           0 :    call outfld( 'qv_aft_Cu      ', state1%q(:,:,1)        , pcols, lchnk )
         827           0 :    call outfld( 'ql_aft_Cu      ', state1%q(:,:,ixcldliq) , pcols, lchnk )
         828           0 :    call outfld( 'qi_aft_Cu      ', state1%q(:,:,ixcldice) , pcols, lchnk )
         829           0 :    call outfld( 't_aft_Cu       ', state1%t               , pcols, lchnk )
         830           0 :    call outfld( 'rh_aft_Cu      ', ftem                   , pcols, lchnk )
         831             :
         832           0 :    tten(:ncol,:)  = ( state1%t(:ncol,:pver) - t_preCu(:ncol,:) ) / ztodt
         833           0 :    rhten(:ncol,:) = ( ftem(:ncol,:) - ftem_preCu(:ncol,:) ) / ztodt
         834             :
         835           0 :    call outfld( 'tten_Cu        ', tten                           , pcols, lchnk )
         836           0 :    call outfld( 'rhten_Cu       ', rhten                          , pcols, lchnk )
         837             :
         838             :
         839             :    ! ------------------------------------------------------------------------ !
         840             :    ! UW-Shallow Cumulus scheme includes                                       !
         841             :    ! evaporation physics inside in it. So when 'shallow_scheme = UW', we must !
         842             :    ! NOT perform below 'zm_conv_evap_run'.                                    !
         843             :    ! ------------------------------------------------------------------------ !
         844             :
         845           0 :    if( shallow_scheme .eq. 'Hack' ) then
         846             :
         847             :    ! ------------------------------------------------------------------------------- !
         848             :    ! Determine the phase of the precipitation produced and add latent heat of fusion !
         849             :    ! Evaporate some of the precip directly into the environment (Sundqvist)          !
         850             :    ! Allow this to use the updated state1 and a fresh ptend_loc type                 !
         851             :    ! Heating and specific humidity tendencies produced                               !
         852             :    ! ------------------------------------------------------------------------------- !
         853             :
         854             :    ! --------------------------------- !
         855             :    ! initialize ptend for next process !
         856             :    ! --------------------------------- !
         857             :
         858           0 :     lq(1) = .TRUE.
         859           0 :     lq(2:) = .FALSE.
         860           0 :     call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap_run', ls=.true., lq=lq)
         861             :
         862           0 :     call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec    )
         863           0 :     call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow    )
         864           0 :     call pbuf_get_field(pbuf, sh_cldliq_idx, sh_cldliq  )
         865           0 :     call pbuf_get_field(pbuf, sh_cldice_idx, sh_cldice  )
         866             :
         867             :     !! clouds have no water... :)
         868           0 :     sh_cldliq(:ncol,:) = 0._r8
         869           0 :     sh_cldice(:ncol,:) = 0._r8
         870             :
         871             :     !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists
         872           0 :     tend_s_snwprd(:,:) = 0._r8
         873           0 :     tend_s_snwevmlt(:,:) = 0._r8
         874           0 :     snow(:) = 0._r8
         875             :     !REMOVECAM_END
         876             :
         877             :     call zm_conv_evap_run(state1%ncol, pver, pverp, &
         878             :          gravit, latice, latvap, tmelt, &
         879             :          cpair, zmconv_ke, zmconv_ke_lnd, zmconv_org, &
         880           0 :          state1%t(:ncol,:),state1%pmid(:ncol,:),state1%pdel(:ncol,:),state1%q(:ncol,:pver,1), &
         881           0 :          landfracdum(:ncol), &
         882           0 :          ptend_loc%s(:ncol,:), tend_s_snwprd(:ncol,:), tend_s_snwevmlt(:ncol,:), ptend_loc%q(:ncol,:pver,1), &
         883           0 :          rprdsh(:ncol,:), cld(:ncol,:), ztodt, &
         884           0 :          precc(:ncol), snow(:ncol), ntprprd(:ncol,:), ntsnprd(:ncol,:), flxprec(:ncol,:), flxsnow(:ncol,:) )
         885             :
         886             :    ! ---------------------------------------------- !
         887             :    ! record history variables from zm_conv_evap_run !
         888             :    ! ---------------------------------------------- !
         889             :
         890           0 :    evapcsh(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1)
         891             :
         892           0 :    ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver) / cpair
         893           0 :    call outfld( 'EVAPTCM '       , ftem                           , pcols, lchnk )
         894           0 :    ftem(:ncol,:pver) = tend_s_snwprd(:ncol,:pver) / cpair
         895           0 :    call outfld( 'FZSNTCM '       , ftem                           , pcols, lchnk )
         896           0 :    ftem(:ncol,:pver) = tend_s_snwevmlt(:ncol,:pver) / cpair
         897           0 :    call outfld( 'EVSNTCM '       , ftem                           , pcols, lchnk )
         898           0 :    call outfld( 'EVAPQCM '       , ptend_loc%q(1,1,1)             , pcols, lchnk )
         899           0 :    call outfld( 'PRECSH  '       , precc                          , pcols, lchnk )
         900           0 :    call outfld( 'HKFLXPRC'       , flxprec                        , pcols, lchnk )
         901           0 :    call outfld( 'HKFLXSNW'       , flxsnow                        , pcols, lchnk )
         902           0 :    call outfld( 'HKNTPRPD'       , ntprprd                        , pcols, lchnk )
         903           0 :    call outfld( 'HKNTSNPD'       , ntsnprd                        , pcols, lchnk )
         904           0 :    call outfld( 'HKEIHEAT'       , ptend_loc%s                    , pcols, lchnk )
         905             :
         906             :    ! ---------------------------------------------------------------- !
         907             :    ! Add tendency from this process to tend from other processes here !
         908             :    ! ---------------------------------------------------------------- !
         909             :
         910           0 :    call physics_ptend_sum( ptend_loc, ptend_all, ncol )
         911           0 :    call physics_ptend_dealloc(ptend_loc)
         912             :
         913             :    ! -------------------------------------------- !
         914             :    ! Do not perform evaporation process for UW-Cu !
         915             :    ! -------------------------------------------- !
         916             :
         917             :    end if
         918             :
         919             :    ! ------------------------------------------------------------- !
         920             :    ! Update name of parameterization tendencies to send to tphysbc !
         921             :    ! ------------------------------------------------------------- !
         922             :
         923           0 :    call physics_state_dealloc(state1)
         924             :
         925             :    ! If we added temperature tendency to pbuf, set it now.
         926           0 :    if (ttend_sh_idx > 0) then
         927           0 :       call pbuf_get_field(pbuf, ttend_sh_idx, ttend_sh)
         928           0 :       ttend_sh(:ncol,:pver) = ptend_all%s(:ncol,:pver)/cpair
         929             :    end if
         930             :
         931           0 :   end subroutine convect_shallow_tend
         932             :
         933             :   end module convect_shallow

Generated by: LCOV version 1.14