LCOV - code coverage report
Current view: | top level - physics/cam7 - convect_diagnostics.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 71 | 72 | 98.6 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             :    module convect_diagnostics
           2             :
           3             :    !----------------------------------------------- !
           4             :    ! Purpose:                                       !
           5             :    !                                                !
           6             :    ! CAM convection diagnostics                     !
           7             :    ! to be called after convection routines         !
           8             :    ! A. Herrington. Nov. 2021                       !
           9             :    !----------------------------------------------- !
          10             :
          11             :    use shr_kind_mod,      only: r8=>shr_kind_r8
          12             :    use ppgrid,            only: pver, pcols, pverp
          13             :    use cam_history,       only: outfld, addfld, horiz_only
          14             :    use phys_control,      only: phys_getopts
          15             :    use cam_abortutils,    only: endrun
          16             :    implicit none
          17             :    private
          18             :    save
          19             :
          20             :    public :: &
          21             :              convect_diagnostics_register,       & ! Register fields in physics buffer
          22             :              convect_diagnostics_init,           & ! Initialize convect diagnostic module
          23             :              convect_diagnostics_calc              ! Return convect diagnostic
          24             :
          25             :    character(len=16) :: shallow_scheme      ! Default set in phys_control.F90, use namelist to change
          26             :
          27             :    ! Physics buffer indices
          28             :    integer    ::     icwmrsh_idx    = 0
          29             :    integer    ::      rprdsh_idx    = 0
          30             :    integer    ::     rprdtot_idx    = 0
          31             :    integer    ::      cldtop_idx    = 0
          32             :    integer    ::      cldbot_idx    = 0
          33             :    integer    :: nevapr_shcu_idx    = 0
          34             :    integer    ::      rprddp_idx    = 0
          35             :    integer    ::     prec_sh_idx    = 0
          36             :    integer    ::     snow_sh_idx    = 0
          37             :    integer    ::    cmfmc_sh_idx    = 0
          38             :
          39             :    contains
          40             :
          41             :   !=============================================================================== !
          42             :   !                                                                                !
          43             :   !=============================================================================== !
          44             :
          45     1496904 :   subroutine convect_diagnostics_register
          46             :
          47             :   !-------------------------------------------------- !
          48             :   ! Purpose : Register fields with the physics buffer !
          49             :   !-------------------------------------------------- !
          50             :   use physics_buffer, only: pbuf_add_field, dtype_r8
          51             :
          52        1536 :   call phys_getopts( shallow_scheme_out = shallow_scheme )
          53             :
          54        1536 :   call pbuf_add_field('ICWMRSH',    'physpkg' ,dtype_r8,(/pcols,pver/),       icwmrsh_idx )
          55        1536 :   call pbuf_add_field('RPRDSH',     'physpkg' ,dtype_r8,(/pcols,pver/),       rprdsh_idx )
          56        1536 :   call pbuf_add_field('RPRDTOT',    'physpkg' ,dtype_r8,(/pcols,pver/),       rprdtot_idx )
          57        1536 :   call pbuf_add_field('CLDTOP',     'physpkg' ,dtype_r8,(/pcols,1/),          cldtop_idx )
          58        1536 :   call pbuf_add_field('CLDBOT',     'physpkg' ,dtype_r8,(/pcols,1/),          cldbot_idx )
          59        1536 :   call pbuf_add_field('NEVAPR_SHCU','physpkg' ,dtype_r8,(/pcols,pver/),       nevapr_shcu_idx )
          60        1536 :   call pbuf_add_field('PREC_SH',    'physpkg' ,dtype_r8,(/pcols/),            prec_sh_idx )
          61        1536 :   call pbuf_add_field('SNOW_SH',    'physpkg' ,dtype_r8,(/pcols/),            snow_sh_idx )
          62             :   ! Updraft mass flux by shallow convection [ kg/s/m2 ]
          63        1536 :   call pbuf_add_field('CMFMC_SH',   'physpkg' ,dtype_r8,(/pcols,pverp/),      cmfmc_sh_idx )
          64             :
          65             :   ! for this implementation, only CLUBB_SGS is supported
          66        1536 :   if (shallow_scheme /= 'CLUBB_SGS') then
          67           0 :      call endrun("convect_diagnostics_register: Unsupported shallow_scheme")
          68             :   end if
          69             :
          70        1536 :   end subroutine convect_diagnostics_register
          71             :
          72             :   !=============================================================================== !
          73             :   !                                                                                !
          74             :   !=============================================================================== !
          75             :
          76        1536 :   subroutine convect_diagnostics_init
          77             :
          78             :   !------------------------------------------------------------------------------- !
          79             :   ! Purpose : Declare output fields, and initialize variables needed by convection !
          80             :   !------------------------------------------------------------------------------- !
          81        1536 :   use physics_buffer,    only: pbuf_get_index
          82             :
          83        3072 :   call addfld( 'CMFMC',      (/ 'ilev' /), 'A', 'kg/m2/s',  'Moist convection (deep+shallow) mass flux'                 )
          84        1536 :   call addfld( 'CLDTOP',     horiz_only,   'I', '1',        'Vertical index of cloud top'                               )
          85        1536 :   call addfld( 'CLDBOT',     horiz_only,   'I', '1',        'Vertical index of cloud base'                              )
          86        1536 :   call addfld( 'PCLDTOP',    horiz_only,   'A', 'Pa',       'Pressure of cloud top'                                     )
          87        1536 :   call addfld( 'PCLDBOT',    horiz_only,   'A', 'Pa',       'Pressure of cloud base'                                    )
          88             :
          89        1536 :   rprddp_idx   = pbuf_get_index('RPRDDP')
          90             :
          91        1536 :   end subroutine convect_diagnostics_init
          92             :
          93             :   !=============================================================================== !
          94             :   !                                                                                !
          95             :   !=============================================================================== !
          96             :
          97     1495368 :   subroutine convect_diagnostics_calc( ztodt  , cmfmc    , &
          98             :                                        qc     , qc2      , rliq     , rliq2    , &
          99             :                                        state  , pbuf)
         100             :
         101        1536 :    use physics_buffer,  only: physics_buffer_desc, pbuf_get_field, pbuf_set_field
         102             :    use physics_types,   only: physics_state
         103             :    implicit none
         104             :
         105             :    ! ---------------------- !
         106             :    ! Input-Output Arguments !
         107             :    ! ---------------------- !
         108             :    type(physics_buffer_desc), pointer :: pbuf(:)
         109             :    type(physics_state), intent(in)    :: state                           ! Physics state variables
         110             :    real(r8),            intent(in)    :: ztodt                           ! 2 delta-t  [ s ]
         111             :
         112             :    real(r8),            intent(out)   :: rliq2(pcols)                    ! Vertically-integrated reserved cloud condensate [ m/s ]
         113             :    real(r8),            intent(out)   :: qc2(pcols,pver)                 ! Same as qc but only from shallow convection scheme
         114             :
         115             :    real(r8),            intent(inout) :: cmfmc(pcols,pverp)    ! Moist deep + shallow convection cloud mass flux [ kg/s/m2 ]
         116             :    real(r8),            intent(inout) :: qc(pcols,pver)        ! dq/dt due to export of cloud water into environment by shallow
         117             :                                                                ! and deep convection [ kg/kg/s ]
         118             :    real(r8),            intent(inout) :: rliq(pcols)           ! Vertical integral of qc [ m/s ]
         119             :
         120             :    integer  :: i
         121             :    integer  :: lchnk                                           ! Chunk identifier
         122             :    integer  :: ncol                                            ! Number of atmospheric columns
         123             :
         124     1495368 :    real(r8),  pointer   :: precc(:)                            ! Shallow convective precipitation (rain+snow) rate at surface [ m/s ]
         125     1495368 :    real(r8),  pointer   :: snow(:)                             ! Shallow convective snow rate at surface [ m/s ]
         126             :
         127             :    real(r8) :: cnt2(pcols)                                     ! Top level of shallow convective activity
         128             :    real(r8) :: cnb2(pcols)                                     ! Bottom level of convective activity
         129             :    real(r8) :: pcnt(pcols)                                     ! Top    pressure level of shallow + deep convective activity
         130             :    real(r8) :: pcnb(pcols)                                     ! Bottom pressure level of shallow + deep convective activity
         131             :
         132     1495368 :    real(r8), pointer, dimension(:,:) :: icwmr                  ! In cloud water + ice mixing ratio
         133     1495368 :    real(r8), pointer, dimension(:,:) :: rprddp                 ! dq/dt due to deep convective rainout
         134     1495368 :    real(r8), pointer, dimension(:,:) :: rprdsh                 ! dq/dt due to deep and shallow convective rainout
         135     1495368 :    real(r8), pointer, dimension(:,:) :: evapcsh                ! Evaporation of shallow convective precipitation >= 0.
         136     1495368 :    real(r8), pointer, dimension(:)   :: cnt
         137     1495368 :    real(r8), pointer, dimension(:)   :: cnb
         138     1495368 :    real(r8), pointer, dimension(:,:) :: cmfmc2                 ! (pcols,pverp) Updraft mass flux by shallow convection [ kg/s/m2 ]
         139             :
         140             :    ! ----------------------- !
         141             :    ! Main Computation Begins !
         142             :    ! ----------------------- !
         143             :
         144     1495368 :    lchnk = state%lchnk
         145     1495368 :    ncol  = state%ncol
         146             :
         147     1495368 :    call pbuf_get_field(pbuf, icwmrsh_idx,     icwmr)
         148             :
         149     1495368 :    call pbuf_get_field(pbuf, rprddp_idx,      rprddp )
         150             :
         151     1495368 :    call pbuf_get_field(pbuf, rprdsh_idx,      rprdsh )
         152             :
         153     1495368 :    call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh  )
         154             :
         155     1495368 :    call pbuf_get_field(pbuf, cldtop_idx,      cnt )
         156             :
         157     1495368 :    call pbuf_get_field(pbuf, cldbot_idx,      cnb )
         158             :
         159     1495368 :    call pbuf_get_field(pbuf, prec_sh_idx,   precc )
         160             :
         161     1495368 :    call pbuf_get_field(pbuf, snow_sh_idx,    snow )
         162             :
         163     1495368 :    call pbuf_get_field(pbuf, cmfmc_sh_idx,  cmfmc2)
         164             :
         165             :    ! If no shallow convection scheme zero out relevant vars
         166             :    ! (should also do the same if there's no deep scheme)
         167     1495368 :    if (shallow_scheme == 'CLUBB_SGS') then
         168  2391093432 :      cmfmc2      = 0._r8
         169  2365672176 :      rprdsh      = 0._r8
         170    25421256 :      precc       = 0._r8
         171  2365672176 :      icwmr       = 0._r8
         172     1495368 :      rliq2       = 0._r8
         173     1495368 :      qc2         = 0._r8
         174    25421256 :      cnt2        = real(pver, r8)
         175    25421256 :      cnb2        = 1._r8
         176  2365672176 :      evapcsh     = 0._r8
         177    25421256 :      snow        = 0._r8
         178             :    end if
         179             :
         180             :    ! ------------------------------------------------------------------------------ !
         181             :    ! Merge shallow convection output with prior results from deep convection scheme !
         182             :    ! ------------------------------------------------------------------------------ !
         183             :
         184             :    ! ----------------------------------------------------------------------- !
         185             :    ! Combine cumulus updraft mass flux : 'cmfmc2'(shallow) + 'cmfmc'(deep)   !
         186             :    ! ----------------------------------------------------------------------- !
         187             :
         188  2348597160 :    cmfmc(:ncol,:) = cmfmc(:ncol,:) + cmfmc2(:ncol,:)
         189             :
         190             :    ! -------------------------------------------------------------- !
         191             :    ! 'cnt2' & 'cnb2' are from shallow, 'cnt' & 'cnb' are from deep  !
         192             :    ! 'cnt2' & 'cnb2' are the interface indices of cloud top & base: !
         193             :    !        cnt2 = float(kpen)                                      !
         194             :    !        cnb2 = float(krel - 1)                                  !
         195             :    ! Note that indices decreases with height.                       !
         196             :    ! -------------------------------------------------------------- !
         197             :
         198    24969168 :    do i = 1, ncol
         199    23473800 :       if( cnt2(i) < cnt(i)) cnt(i) = cnt2(i)
         200    23473800 :       if( cnb2(i) > cnb(i)) cnb(i) = cnb2(i)
         201    23473800 :       if( cnb(i) == 1._r8 ) cnb(i) = cnt(i)
         202    23473800 :       pcnt(i) = state%pmid(i,int(cnt(i)))
         203    24969168 :       pcnb(i) = state%pmid(i,int(cnb(i)))
         204             :    end do
         205             :
         206             :    ! ----------------------------------------------- !
         207             :    ! This quantity was previously known as CMFDQR.   !
         208             :    ! Now CMFDQR is the shallow rain production only. !
         209             :    ! ----------------------------------------------- !
         210             :
         211  2326618728 :    call pbuf_set_field(pbuf, rprdtot_idx, rprdsh(:ncol,:pver) + rprddp(:ncol,:pver), start=(/1,1/), kount=(/ncol,pver/))
         212             :
         213             :    ! ----------------------------------------------------------------------- !
         214             :    ! Add shallow reserved cloud condensate to deep reserved cloud condensate !
         215             :    !     qc [ kg/kg/s] , rliq [ m/s ]                                        !
         216             :    ! ----------------------------------------------------------------------- !
         217             :
         218  2323627992 :    qc(:ncol,:pver) = qc(:ncol,:pver) + qc2(:ncol,:pver)
         219    24969168 :    rliq(:ncol)     = rliq(:ncol) + rliq2(:ncol)
         220             :
         221             :    ! ---------------------------------------------------------------------------- !
         222             :    ! Output new partition of cloud condensate variables, as well as precipitation !
         223             :    ! ---------------------------------------------------------------------------- !
         224             :
         225     1495368 :    call outfld( 'CMFMC'  , cmfmc                     , pcols   , lchnk )
         226     1495368 :    call outfld( 'CLDTOP' , cnt                       , pcols   , lchnk )
         227     1495368 :    call outfld( 'CLDBOT' , cnb                       , pcols   , lchnk )
         228     1495368 :    call outfld( 'PCLDTOP', pcnt                      , pcols   , lchnk )
         229     1495368 :    call outfld( 'PCLDBOT', pcnb                      , pcols   , lchnk )
         230             :
         231     2990736 :   end subroutine convect_diagnostics_calc
         232             :
         233             :   end module convect_diagnostics

Generated by: LCOV version 1.14