LCOV - code coverage report
Current view: | top level - physics/cam - uwshcu.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 11 | 2295 | 0.5 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 1 | 16 | 6.2 %

              Line data    Source code
           1             :   module uwshcu
           2             :
           3             :   use shr_spfn_mod,   only: erfc => shr_spfn_erfc
           4             :   use cam_logfile,    only: iulog
           5             :   use ppgrid,         only: pcols, pver, pverp
           6             :   use cam_abortutils, only: endrun
           7             :   use spmd_utils,     only: masterproc
           8             :   use wv_saturation,  only: qsat
           9             :
          10             :
          11             :   implicit none
          12             :   private
          13             :   save
          14             :
          15             :   public &
          16             :      uwshcu_readnl,      &
          17             :      init_uwshcu,        &
          18             :      compute_uwshcu,     &
          19             :      compute_uwshcu_inv
          20             :
          21             :   integer , parameter :: r8 = selected_real_kind(12)    !  8 byte real
          22             :   real(r8), parameter :: unset_r8 = huge(1.0_r8)
          23             :   real(r8)            :: xlv                            !  Latent heat of vaporization
          24             :   real(r8)            :: xlf                            !  Latent heat of fusion
          25             :   real(r8)            :: xls                            !  Latent heat of sublimation = xlv + xlf
          26             :   real(r8)            :: cp                             !  Specific heat of dry air
          27             :   real(r8)            :: zvir                           !  rh2o/rair - 1
          28             :   real(r8)            :: r                              !  Gas constant for dry air
          29             :   real(r8)            :: g                              !  Gravitational constant
          30             :   real(r8)            :: ep2                            !  mol wgt water vapor / mol wgt dry air
          31             :   real(r8)            :: p00                            !  Reference pressure for exner function
          32             :   real(r8)            :: rovcp                          !  R/cp
          33             :
          34             :   ! Tuning parameters set via namelist
          35             :   real(r8) :: rpen          !  For penetrative entrainment efficiency
          36             :
          37             : !===============================================================================
          38             : contains
          39             : !===============================================================================
          40             :
          41           0 :   real(r8) function exnf(pressure)
          42             :            real(r8), intent(in)              :: pressure
          43           0 :            exnf = (pressure/p00)**rovcp
          44             :            return
          45             :   end function exnf
          46             :
          47             : !===============================================================================
          48             :
          49        1536 : subroutine uwshcu_readnl(nlfile)
          50             :
          51             :    use namelist_utils,  only: find_group_name
          52             :    use units,           only: getunit, freeunit
          53             :    use mpishorthand
          54             :
          55             :    character(len=*), intent(in) :: nlfile  ! filepath for file containing namelist input
          56             :
          57             :    ! Local variables
          58             :    integer :: unitn, ierr
          59             :    character(len=*), parameter :: subname = 'uwshcu_readnl'
          60             :
          61             :    ! Namelist variables
          62             :    real(r8) :: uwshcu_rpen =  unset_r8    !  For penetrative entrainment efficiency
          63             :
          64             :    namelist /uwshcu_nl/ uwshcu_rpen
          65             :    !-----------------------------------------------------------------------------
          66             :
          67        1536 :    if (masterproc) then
          68           2 :       unitn = getunit()
          69           2 :       open( unitn, file=trim(nlfile), status='old' )
          70           2 :       call find_group_name(unitn, 'uwshcu_nl', status=ierr)
          71           2 :       if (ierr == 0) then
          72           0 :          read(unitn, uwshcu_nl, iostat=ierr)
          73           0 :          if (ierr /= 0) then
          74           0 :             call endrun(subname // ':: ERROR reading namelist')
          75             :          end if
          76             :       end if
          77           2 :       close(unitn)
          78           2 :       call freeunit(unitn)
          79             :    end if
          80             :
          81             : #ifdef SPMD
          82             :    ! Broadcast namelist variables
          83        1536 :    call mpibcast(uwshcu_rpen,            1, mpir8,  0, mpicom)
          84             : #endif
          85             :
          86        1536 :    rpen=uwshcu_rpen
          87             :
          88             :
          89        1536 : end subroutine uwshcu_readnl
          90             :
          91             : !===============================================================================
          92             :
          93           0 :   subroutine init_uwshcu( kind, xlv_in, cp_in, xlf_in, zvir_in, r_in, g_in, ep2_in )
          94             :
          95             :     !------------------------------------------------------------- !
          96             :     ! Purpose:                                                     !
          97             :     ! Initialize key constants for the shallow convection package. !
          98             :     !------------------------------------------------------------- !
          99             :
         100             :     use cam_history,   only: addfld, horiz_only
         101             :     implicit none
         102             :     integer , intent(in) :: kind       !  kind of reals being passed in
         103             :     real(r8), intent(in) :: xlv_in     !  Latent heat of vaporization
         104             :     real(r8), intent(in) :: xlf_in     !  Latent heat of fusion
         105             :     real(r8), intent(in) :: cp_in      !  Specific heat of dry air
         106             :     real(r8), intent(in) :: zvir_in    !  rh2o/rair - 1
         107             :     real(r8), intent(in) :: r_in       !  Gas constant for dry air
         108             :     real(r8), intent(in) :: g_in       !  Gravitational constant
         109             :     real(r8), intent(in) :: ep2_in     !  mol wgt water vapor / mol wgt dry air
         110             :
         111             :     character(len=*), parameter :: subname = 'init_uwshcu'
         112             :
         113             :     ! ------------------------- !
         114             :     ! Internal Output Variables !
         115             :     ! ------------------------- !
         116             :
         117           0 :     call addfld( 'qtflx_Cu'       , (/ 'ilev' /),  'A', 'kg/m2/s' , 'Convective qt flux'         )
         118           0 :     call addfld( 'slflx_Cu'       , (/ 'ilev' /),  'A', 'J/m2/s'  , 'Convective sl flux'         )
         119           0 :     call addfld( 'uflx_Cu'        , (/ 'ilev' /),  'A', 'kg/m/s2' , 'Convective  u flux'         )
         120           0 :     call addfld( 'vflx_Cu'        , (/ 'ilev' /),  'A', 'kg/m/s2' , 'Convective  v flux'         )
         121             :
         122           0 :     call addfld( 'qtten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'qt tendency by convection'  )
         123           0 :     call addfld( 'slten_Cu'       , (/ 'lev' /),   'A', 'J/kg/s'  , 'sl tendency by convection'  )
         124           0 :     call addfld( 'uten_Cu'        , (/ 'lev' /),   'A', 'm/s2'    , ' u tendency by convection'  )
         125           0 :     call addfld( 'vten_Cu'        , (/ 'lev' /),   'A', 'm/s2'    , ' v tendency by convection'  )
         126           0 :     call addfld( 'qvten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'qv tendency by convection'  )
         127           0 :     call addfld( 'qlten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'ql tendency by convection'  )
         128           0 :     call addfld( 'qiten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'qi tendency by convection'  )
         129             :
         130           0 :     call addfld( 'cbmf_Cu'        , horiz_only,    'A', 'kg/m2/s' , 'Cumulus base mass flux'                               )
         131           0 :     call addfld( 'ufrcinvbase_Cu' , horiz_only,    'A', 'fraction', 'Cumulus fraction at PBL top'                          )
         132           0 :     call addfld( 'ufrclcl_Cu'     , horiz_only,    'A', 'fraction', 'Cumulus fraction at LCL'                              )
         133           0 :     call addfld( 'winvbase_Cu'    , horiz_only,    'A', 'm/s'     , 'Cumulus vertical velocity at PBL top'                 )
         134           0 :     call addfld( 'wlcl_Cu'        , horiz_only,    'A', 'm/s'     , 'Cumulus vertical velocity at LCL'                     )
         135           0 :     call addfld( 'plcl_Cu'        , horiz_only,    'A', 'Pa'      , 'LCL of source air'                                    )
         136           0 :     call addfld( 'pinv_Cu'        , horiz_only,    'A', 'Pa'      , 'PBL top pressure'                                     )
         137           0 :     call addfld( 'plfc_Cu'        , horiz_only,    'A', 'Pa'      , 'LFC of source air'                                    )
         138           0 :     call addfld( 'pbup_Cu'        , horiz_only,    'A', 'Pa'      , 'Highest interface level of positive cumulus buoyancy' )
         139           0 :     call addfld( 'ppen_Cu'        , horiz_only,    'A', 'Pa'      , 'Highest level where cumulus w is 0'                   )
         140           0 :     call addfld( 'qtsrc_Cu'       , horiz_only,    'A', 'kg/kg'   , 'Cumulus source air qt'                                )
         141           0 :     call addfld( 'thlsrc_Cu'      , horiz_only,    'A', 'K'       , 'Cumulus source air thl'                               )
         142           0 :     call addfld( 'thvlsrc_Cu'     , horiz_only,    'A', 'K'       , 'Cumulus source air thvl'                              )
         143           0 :     call addfld( 'emfkbup_Cu'     , horiz_only,    'A', 'kg/m2/s' ,  'Penetrative mass flux at kbup'                       )
         144           0 :     call addfld( 'cin_Cu'         , horiz_only,    'A', 'J/kg'    , 'CIN upto LFC'                                         )
         145           0 :     call addfld( 'cinlcl_Cu'      , horiz_only,    'A', 'J/kg'    , 'CIN upto LCL'                                         )
         146           0 :     call addfld( 'cbmflimit_Cu'   , horiz_only,    'A', 'kg/m2/s' , 'cbmflimiter'                                          )
         147           0 :     call addfld( 'tkeavg_Cu'      , horiz_only,    'A', 'm2/s2'   , 'Average tke within PBL for convection scheme'         )
         148           0 :     call addfld( 'zinv_Cu'        , horiz_only,    'A', 'm'       , 'PBL top height'                                       )
         149           0 :     call addfld( 'rcwp_Cu'        , horiz_only,    'A', 'kg/m2'   , 'Cumulus LWP+IWP'                                      )
         150           0 :     call addfld( 'rlwp_Cu'        , horiz_only,    'A', 'kg/m2'   , 'Cumulus LWP'                                          )
         151           0 :     call addfld( 'riwp_Cu'        , horiz_only,    'A', 'kg/m2'   , 'Cumulus IWP'                                          )
         152           0 :     call addfld( 'tophgt_Cu'      , horiz_only,    'A', 'm'       , 'Cumulus top height'                                   )
         153             :
         154           0 :     call addfld( 'wu_Cu'          , (/ 'ilev' /),  'A', 'm/s'     , 'Convective updraft vertical velocity'             )
         155           0 :     call addfld( 'ufrc_Cu'        , (/ 'ilev' /),  'A', 'fraction', 'Convective updraft fractional area'               )
         156           0 :     call addfld( 'qtu_Cu'         , (/ 'ilev' /),  'A', 'kg/kg'   , 'Cumulus updraft qt'                               )
         157           0 :     call addfld( 'thlu_Cu'        , (/ 'ilev' /),  'A', 'K'       , 'Cumulus updraft thl'                              )
         158           0 :     call addfld( 'thvu_Cu'        , (/ 'ilev' /),  'A', 'K'       , 'Cumulus updraft thv'                              )
         159           0 :     call addfld( 'uu_Cu'          , (/ 'ilev' /),  'A', 'm/s'     , 'Cumulus updraft uwnd'                             )
         160           0 :     call addfld( 'vu_Cu'          , (/ 'ilev' /),  'A', 'm/s'     , 'Cumulus updraft vwnd'                             )
         161           0 :     call addfld( 'qtu_emf_Cu'     , (/ 'ilev' /),  'A', 'kg/kg'   , 'qt of penatratively entrained air'                )
         162           0 :     call addfld( 'thlu_emf_Cu'    , (/ 'ilev' /),  'A', 'K'       , 'thl of penatratively entrained air'               )
         163           0 :     call addfld( 'uu_emf_Cu'      , (/ 'ilev' /),  'A', 'm/s'     , 'uwnd of penatratively entrained air'              )
         164           0 :     call addfld( 'vu_emf_Cu'      , (/ 'ilev' /),  'A', 'm/s'     , 'vwnd of penatratively entrained air'              )
         165           0 :     call addfld( 'umf_Cu'         , (/ 'ilev' /),  'A', 'kg/m2/s' , 'Cumulus updraft mass flux'                        )
         166           0 :     call addfld( 'uemf_Cu'        , (/ 'ilev' /),  'A', 'kg/m2/s' , 'Cumulus net ( updraft + entrainment ) mass flux'  )
         167           0 :     call addfld( 'qcu_Cu'         , (/ 'lev' /),   'A', 'kg/kg'   , 'Cumulus updraft LWC+IWC'                          )
         168           0 :     call addfld( 'qlu_Cu'         , (/ 'lev' /),   'A', 'kg/kg'   , 'Cumulus updraft LWC'                              )
         169           0 :     call addfld( 'qiu_Cu'         , (/ 'lev' /),   'A', 'kg/kg'   , 'Cumulus updraft IWC'                              )
         170           0 :     call addfld( 'cufrc_Cu'       , (/ 'lev' /),   'A', 'fraction', 'Cumulus cloud fraction'                           )
         171           0 :     call addfld( 'fer_Cu'         , (/ 'lev' /),   'A', '1/m'     , 'Cumulus lateral fractional entrainment rate'      )
         172           0 :     call addfld( 'fdr_Cu'         , (/ 'lev' /),   'A', '1/m'     , 'Cumulus lateral fractional detrainment Rate'      )
         173             :
         174           0 :     call addfld( 'dwten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'Expellsion rate of cumulus cloud water to env.'   )
         175           0 :     call addfld( 'diten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'Expellsion rate of cumulus ice water to env.'     )
         176           0 :     call addfld( 'qrten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'Production rate of rain by cumulus'               )
         177           0 :     call addfld( 'qsten_Cu'       , (/ 'lev' /),   'A', 'kg/kg/s' , 'Production rate of snow by cumulus'               )
         178           0 :     call addfld( 'flxrain_Cu'     , (/ 'ilev' /),  'A', 'kg/m2/s' , 'Rain flux induced by Cumulus'                     )
         179           0 :     call addfld( 'flxsnow_Cu'     , (/ 'ilev' /),  'A', 'kg/m2/s' , 'Snow flux induced by Cumulus'                     )
         180           0 :     call addfld( 'ntraprd_Cu'     , (/ 'lev' /),   'A', 'kg/kg/s' , 'Net production rate of rain by Cumulus'           )
         181           0 :     call addfld( 'ntsnprd_Cu'     , (/ 'lev' /),   'A', 'kg/kg/s' , 'Net production rate of snow by Cumulus'           )
         182             :
         183           0 :     call addfld( 'excessu_Cu'     , (/ 'lev' /),   'A', 'no'      , 'Updraft saturation excess'                        )
         184           0 :     call addfld( 'excess0_Cu'     , (/ 'lev' /),   'A', 'no'      , 'Environmental saturation excess'                  )
         185           0 :     call addfld( 'xc_Cu'          , (/ 'lev' /),   'A', 'no'      , 'Critical mixing ratio'                            )
         186           0 :     call addfld( 'aquad_Cu'       , (/ 'lev' /),   'A', 'no'      , 'aquad'                                            )
         187           0 :     call addfld( 'bquad_Cu'       , (/ 'lev' /),   'A', 'no'      , 'bquad'                                            )
         188           0 :     call addfld( 'cquad_Cu'       , (/ 'lev' /),   'A', 'no'      , 'cquad'                                            )
         189           0 :     call addfld( 'bogbot_Cu'      , (/ 'lev' /),   'A', 'no'      , 'Cloud buoyancy at the bottom interface'           )
         190           0 :     call addfld( 'bogtop_Cu'      , (/ 'lev' /),   'A', 'no'      , 'Cloud buoyancy at the top interface'              )
         191             :
         192           0 :     call addfld('exit_UWCu_Cu'    , horiz_only,    'A', 'no' , 'exit_UWCu'     )
         193           0 :     call addfld('exit_conden_Cu'  , horiz_only,    'A', 'no' , 'exit_conden'   )
         194           0 :     call addfld('exit_klclmkx_Cu' , horiz_only,    'A', 'no' , 'exit_klclmkx'  )
         195           0 :     call addfld('exit_klfcmkx_Cu' , horiz_only,    'A', 'no' , 'exit_klfcmkx'  )
         196           0 :     call addfld('exit_ufrc_Cu'    , horiz_only,    'A', 'no' , 'exit_ufrc'     )
         197           0 :     call addfld('exit_wtw_Cu'     , horiz_only,    'A', 'no' , 'exit_wtw'      )
         198           0 :     call addfld('exit_drycore_Cu' , horiz_only,    'A', 'no' , 'exit_drycore'  )
         199           0 :     call addfld('exit_wu_Cu'      , horiz_only,    'A', 'no' , 'exit_wu'       )
         200           0 :     call addfld('exit_cufilter_Cu', horiz_only,    'A', 'no' , 'exit_cufilter' )
         201           0 :     call addfld('exit_kinv1_Cu'   , horiz_only,    'A', 'no' , 'exit_kinv1'    )
         202           0 :     call addfld('exit_rei_Cu'     , horiz_only,    'A', 'no' , 'exit_rei'      )
         203             :
         204           0 :     call addfld('limit_shcu_Cu'   , horiz_only,    'A', 'no' , 'limit_shcu'    )
         205           0 :     call addfld('limit_negcon_Cu' , horiz_only,    'A', 'no' , 'limit_negcon'  )
         206           0 :     call addfld('limit_ufrc_Cu'   , horiz_only,    'A', 'no' , 'limit_ufrc'    )
         207           0 :     call addfld('limit_ppen_Cu'   , horiz_only,    'A', 'no' , 'limit_ppen'    )
         208           0 :     call addfld('limit_emf_Cu'    , horiz_only,    'A', 'no' , 'limit_emf'     )
         209           0 :     call addfld('limit_cinlcl_Cu' , horiz_only,    'A', 'no' , 'limit_cinlcl'  )
         210           0 :     call addfld('limit_cin_Cu'    , horiz_only,    'A', 'no' , 'limit_cin'     )
         211           0 :     call addfld('limit_cbmf_Cu'   , horiz_only,    'A', 'no' , 'limit_cbmf'    )
         212           0 :     call addfld('limit_rei_Cu'    , horiz_only,    'A', 'no' , 'limit_rei'     )
         213           0 :     call addfld('ind_delcin_Cu'   , horiz_only,    'A', 'no' , 'ind_delcin'    )
         214             :
         215           0 :     if( kind .ne. r8 ) then
         216           0 :         write(iulog,*) subname//': ERROR -- real KIND does not match internal specification.'
         217           0 :         call endrun(subname//': ERROR -- real KIND does not match internal specification.')
         218             :     endif
         219             :
         220           0 :     xlv   = xlv_in
         221           0 :     xlf   = xlf_in
         222           0 :     xls   = xlv + xlf
         223           0 :     cp    = cp_in
         224           0 :     zvir  = zvir_in
         225           0 :     r     = r_in
         226           0 :     g     = g_in
         227           0 :     ep2   = ep2_in
         228           0 :     p00   = 1.e5_r8
         229           0 :     rovcp = r/cp
         230             :
         231           0 :     if (rpen == unset_r8) then
         232           0 :        call endrun(subname//': uwshcu_rpen must be set in the namelist')
         233             :     end if
         234             :
         235           0 :     if ( masterproc ) then
         236           0 :        write(iulog,*) subname//': tuning parameters: rpen=',rpen
         237             :     endif
         238             :
         239           0 :   end subroutine init_uwshcu
         240             :
         241           0 :   subroutine compute_uwshcu_inv( mix      , mkx        , iend          , ncnst     , dt       ,  &
         242           0 :                                  ps0_inv  , zs0_inv    , p0_inv        , z0_inv    , dp0_inv  ,  &
         243           0 :                                  u0_inv   , v0_inv     , qv0_inv       , ql0_inv   , qi0_inv  ,  &
         244           0 :                                  t0_inv   , s0_inv     , tr0_inv       ,                         &
         245           0 :                                  tke_inv  , cldfrct_inv, concldfrct_inv, pblh      , cush     ,  &
         246           0 :                                  umf_inv  , slflx_inv  , qtflx_inv     ,                         &
         247           0 :                                  flxprc1_inv, flxsnow1_inv,                                      &
         248           0 :                                  qvten_inv, qlten_inv  , qiten_inv     ,                         &
         249           0 :                                  sten_inv , uten_inv   , vten_inv      , trten_inv ,             &
         250           0 :                                  qrten_inv, qsten_inv  , precip        , snow      , evapc_inv,  &
         251           0 :                                  cufrc_inv, qcu_inv    , qlu_inv       , qiu_inv   ,             &
         252           0 :                                  cbmf     , qc_inv     , rliq          ,                         &
         253           0 :                                  cnt_inv  , cnb_inv    , lchnk         , dpdry0_inv,             &
         254           0 :                                  sh_e_ed_ratio                                                   )
         255             :
         256             :     implicit none
         257             :     integer , intent(in)    :: lchnk
         258             :     integer , intent(in)    :: mix
         259             :     integer , intent(in)    :: mkx
         260             :     integer , intent(in)    :: iend
         261             :     integer , intent(in)    :: ncnst
         262             :     real(r8), intent(in)    :: dt                       !  Time step : 2*delta_t [ s ]
         263             :     real(r8), intent(in)    :: ps0_inv(mix,mkx+1)       !  Environmental pressure at the interfaces [ Pa ]
         264             :     real(r8), intent(in)    :: zs0_inv(mix,mkx+1)       !  Environmental height at the interfaces   [ m ]
         265             :     real(r8), intent(in)    :: p0_inv(mix,mkx)          !  Environmental pressure at the layer mid-point [ Pa ]
         266             :     real(r8), intent(in)    :: z0_inv(mix,mkx)          !  Environmental height at the layer mid-point [ m ]
         267             :     real(r8), intent(in)    :: dp0_inv(mix,mkx)         !  Environmental layer pressure thickness [ Pa ] > 0.
         268             :     real(r8), intent(in)    :: dpdry0_inv(mix,mkx)      !  Environmental dry layer pressure thickness [ Pa ]
         269             :     real(r8), intent(in)    :: u0_inv(mix,mkx)          !  Environmental zonal wind [ m/s ]
         270             :     real(r8), intent(in)    :: v0_inv(mix,mkx)          !  Environmental meridional wind [ m/s ]
         271             :     real(r8), intent(in)    :: qv0_inv(mix,mkx)         !  Environmental water vapor specific humidity [ kg/kg ]
         272             :     real(r8), intent(in)    :: ql0_inv(mix,mkx)         !  Environmental liquid water specific humidity [ kg/kg ]
         273             :     real(r8), intent(in)    :: qi0_inv(mix,mkx)         !  Environmental ice specific humidity [ kg/kg ]
         274             :     real(r8), intent(in)    :: t0_inv(mix,mkx)          !  Environmental temperature [ K ]
         275             :     real(r8), intent(in)    :: s0_inv(mix,mkx)          !  Environmental dry static energy [ J/kg ]
         276             :     real(r8), intent(in)    :: tr0_inv(mix,mkx,ncnst)   !  Environmental tracers [ #, kg/kg ]
         277             :     real(r8), intent(in)    :: tke_inv(mix,mkx+1)       !  Turbulent kinetic energy at the interfaces [ m2/s2 ]
         278             :     real(r8), intent(in)    :: cldfrct_inv(mix,mkx)     !  Total cloud fraction at the previous time step [ fraction ]
         279             :     real(r8), intent(in)    :: concldfrct_inv(mix,mkx)  !  Total convective ( shallow + deep ) cloud fraction
         280             :                                                         !  at the previous time step [ fraction ]
         281             :     real(r8), intent(in)    :: pblh(mix)                !  Height of PBL [ m ]
         282             :     real(r8), intent(inout) :: cush(mix)                !  Convective scale height [ m ]
         283             :     real(r8), intent(out)   :: umf_inv(mix,mkx+1)       !  Updraft mass flux at the interfaces [ kg/m2/s ]
         284             :     real(r8), intent(out)   :: qvten_inv(mix,mkx)       !  Tendency of water vapor specific humidity [ kg/kg/s ]
         285             :     real(r8), intent(out)   :: qlten_inv(mix,mkx)       !  Tendency of liquid water specific humidity [ kg/kg/s ]
         286             :     real(r8), intent(out)   :: qiten_inv(mix,mkx)       !  Tendency of ice specific humidity [ kg/kg/s ]
         287             :     real(r8), intent(out)   :: sten_inv(mix,mkx)        !  Tendency of dry static energy [ J/kg/s ]
         288             :     real(r8), intent(out)   :: uten_inv(mix,mkx)        !  Tendency of zonal wind [ m/s2 ]
         289             :     real(r8), intent(out)   :: vten_inv(mix,mkx)        !  Tendency of meridional wind [ m/s2 ]
         290             :     real(r8), intent(out)   :: trten_inv(mix,mkx,ncnst) !  Tendency of tracers [ #/s, kg/kg/s ]
         291             :     real(r8), intent(out)   :: qrten_inv(mix,mkx)       !  Tendency of rain water specific humidity [ kg/kg/s ]
         292             :     real(r8), intent(out)   :: qsten_inv(mix,mkx)       !  Tendency of snow specific humidity [ kg/kg/s ]
         293             :     real(r8), intent(out)   :: precip(mix)              !  Precipitation ( rain + snow ) flux at the surface [ m/s ]
         294             :     real(r8), intent(out)   :: snow(mix)                !  Snow flux at the surface [ m/s ]
         295             :     real(r8), intent(out)   :: evapc_inv(mix,mkx)       !  Evaporation of precipitation [ kg/kg/s ]
         296             :     real(r8), intent(out)   :: rliq(mix)                !  Vertical integral of tendency of detrained cloud condensate qc [ m/s ]
         297             :     real(r8), intent(out)   :: slflx_inv(mix,mkx+1)     !  Updraft liquid static energy flux [ J/kg * kg/m2/s ]
         298             :     real(r8), intent(out)   :: qtflx_inv(mix,mkx+1)     !  Updraft total water flux [ kg/kg * kg/m2/s ]
         299             :     real(r8), intent(out)   :: flxprc1_inv(mix,mkx+1)   ! uw grid-box mean rain+snow flux (kg m^-2 s^-1)
         300             :                                                         ! for physics buffer calls in convect_shallow.F90
         301             :     real(r8), intent(out)   :: flxsnow1_inv(mix,mkx+1)  ! uw grid-box mean snow flux (kg m^-2 s^-1)
         302             :                                                         ! for physics buffer calls in convect_shallow.F90
         303             :
         304             :     real(r8), intent(out)   :: cufrc_inv(mix,mkx)       !  Shallow cumulus cloud fraction at the layer mid-point [ fraction ]
         305             :     real(r8), intent(out)   :: qcu_inv(mix,mkx)         !  Liquid+ice specific humidity within cumulus updraft [ kg/kg ]
         306             :     real(r8), intent(out)   :: qlu_inv(mix,mkx)         !  Liquid water specific humidity within cumulus updraft [ kg/kg ]
         307             :     real(r8), intent(out)   :: qiu_inv(mix,mkx)         !  Ice specific humidity within cumulus updraft [ kg/kg ]
         308             :     real(r8), intent(out)   :: qc_inv(mix,mkx)          !  Tendency of cumulus condensate detrained into the environment [ kg/kg/s ]
         309             :     real(r8), intent(out)   :: cbmf(mix)                !  Cumulus base mass flux [ kg/m2/s ]
         310             :     real(r8), intent(out)   :: cnt_inv(mix)             !  Cumulus top  interface index, cnt = kpen [ no ]
         311             :     real(r8), intent(out)   :: cnb_inv(mix)             !  Cumulus base interface index, cnb = krel - 1 [ no ]
         312             :
         313             :     real(r8), intent(out)   :: sh_e_ed_ratio(mix,mkx)   !  shallow conv [ent/(ent+det)] ratio
         314             :
         315             :
         316           0 :     real(r8)                :: ps0(mix,0:mkx)           !  Environmental pressure at the interfaces [ Pa ]
         317           0 :     real(r8)                :: zs0(mix,0:mkx)           !  Environmental height at the interfaces   [ m ]
         318           0 :     real(r8)                :: p0(mix,mkx)              !  Environmental pressure at the layer mid-point [ Pa ]
         319           0 :     real(r8)                :: z0(mix,mkx)              !  Environmental height at the layer mid-point [ m ]
         320           0 :     real(r8)                :: dp0(mix,mkx)             !  Environmental layer pressure thickness [ Pa ] > 0.
         321           0 :     real(r8)                :: dpdry0(mix,mkx)          !  Environmental dry layer pressure thickness [ Pa ]
         322           0 :     real(r8)                :: u0(mix,mkx)              !  Environmental zonal wind [ m/s ]
         323           0 :     real(r8)                :: v0(mix,mkx)              !  Environmental meridional wind [ m/s ]
         324           0 :     real(r8)                :: tke(mix,0:mkx)           !  Turbulent kinetic energy at the interfaces [ m2/s2 ]
         325           0 :     real(r8)                :: cldfrct(mix,mkx)         !  Total cloud fraction at the previous time step [ fraction ]
         326           0 :     real(r8)                :: concldfrct(mix,mkx)      !  Total convective ( shallow + deep ) cloud fraction
         327             :                                                         ! at the previous time step [ fraction ]
         328           0 :     real(r8)                :: qv0(mix,mkx)             !  Environmental water vapor specific humidity [ kg/kg ]
         329           0 :     real(r8)                :: ql0(mix,mkx)             !  Environmental liquid water specific humidity [ kg/kg ]
         330           0 :     real(r8)                :: qi0(mix,mkx)             !  Environmental ice specific humidity [ kg/kg ]
         331           0 :     real(r8)                :: t0(mix,mkx)              !  Environmental temperature [ K ]
         332           0 :     real(r8)                :: s0(mix,mkx)              !  Environmental dry static energy [ J/kg ]
         333           0 :     real(r8)                :: tr0(mix,mkx,ncnst)       !  Environmental tracers [ #, kg/kg ]
         334           0 :     real(r8)                :: umf(mix,0:mkx)           !  Updraft mass flux at the interfaces [ kg/m2/s ]
         335           0 :     real(r8)                :: qvten(mix,mkx)           !  Tendency of water vapor specific humidity [ kg/kg/s ]
         336           0 :     real(r8)                :: qlten(mix,mkx)           !  Tendency of liquid water specific humidity [ kg/kg/s ]
         337           0 :     real(r8)                :: qiten(mix,mkx)           !  tendency of ice specific humidity [ kg/kg/s ]
         338           0 :     real(r8)                :: sten(mix,mkx)            !  Tendency of static energy [ J/kg/s ]
         339           0 :     real(r8)                :: uten(mix,mkx)            !  Tendency of zonal wind [ m/s2 ]
         340           0 :     real(r8)                :: vten(mix,mkx)            !  Tendency of meridional wind [ m/s2 ]
         341           0 :     real(r8)                :: trten(mix,mkx,ncnst)     !  Tendency of tracers [ #/s, kg/kg/s ]
         342           0 :     real(r8)                :: qrten(mix,mkx)           !  Tendency of rain water specific humidity [ kg/kg/s ]
         343           0 :     real(r8)                :: qsten(mix,mkx)           !  Tendency of snow speficif humidity [ kg/kg/s ]
         344           0 :     real(r8)                :: evapc(mix,mkx)           !  Tendency of evaporation of precipitation [ kg/kg/s ]
         345           0 :     real(r8)                :: slflx(mix,0:mkx)         !  Updraft liquid static energy flux [ J/kg * kg/m2/s ]
         346           0 :     real(r8)                :: qtflx(mix,0:mkx)         !  Updraft total water flux [ kg/kg * kg/m2/s ]
         347           0 :     real(r8)                :: flxprc1(mix,0:mkx)       ! uw grid-box mean rain+snow flux (kg m^-2 s^-1)
         348             :                                                         ! for physics buffer calls in convect_shallow.F90
         349           0 :     real(r8)                :: flxsnow1(mix,0:mkx)      ! uw grid-box mean snow flux (kg m^-2 s^-1)
         350             :                                                         ! for physics buffer calls in convect_shallow.F90
         351           0 :     real(r8)                :: cufrc(mix,mkx)           !  Shallow cumulus cloud fraction at the layer mid-point [ fraction ]
         352           0 :     real(r8)                :: qcu(mix,mkx)             !  Condensate water specific humidity within cumulus updraft
         353             :                                                         ! at the layer mid-point [ kg/kg ]
         354           0 :     real(r8)                :: qlu(mix,mkx)             !  Liquid water specific humidity within cumulus updraft
         355             :                                                         ! at the layer mid-point [ kg/kg ]
         356           0 :     real(r8)                :: qiu(mix,mkx)             !  Ice specific humidity within cumulus updraft
         357             :                                                         ! at the layer mid-point [ kg/kg ]
         358           0 :     real(r8)                :: qc(mix,mkx)              !  Tendency of cumulus condensate detrained into the environment [ kg/kg/s ]
         359           0 :     real(r8)                :: cnt(mix)                 !  Cumulus top  interface index, cnt = kpen [ no ]
         360           0 :     real(r8)                :: cnb(mix)                 !  Cumulus base interface index, cnb = krel - 1 [ no ]
         361             :
         362           0 :     real(r8)                :: fer_out(mix,mkx)         !  Fractional lateral entrainment rate [ 1/Pa ]
         363           0 :     real(r8)                :: fdr_out(mix,mkx)         !  Fractional lateral detrainment rate [ 1/Pa ]
         364             :
         365             :     integer                 :: i
         366             :     integer                 :: k                        !  Vertical index for local fields [ no ]
         367             :     integer                 :: k_inv                    !  Vertical index for incoming fields [ no ]
         368             :     integer                 :: m                        !  Tracer index [ no ]
         369             :
         370           0 :     do k = 1, mkx
         371           0 :        k_inv               = mkx + 1 - k
         372           0 :        p0(:iend,k)         = p0_inv(:iend,k_inv)
         373           0 :        u0(:iend,k)         = u0_inv(:iend,k_inv)
         374           0 :        v0(:iend,k)         = v0_inv(:iend,k_inv)
         375           0 :        z0(:iend,k)         = z0_inv(:iend,k_inv)
         376           0 :        dp0(:iend,k)        = dp0_inv(:iend,k_inv)
         377           0 :        dpdry0(:iend,k)     = dpdry0_inv(:iend,k_inv)
         378           0 :        qv0(:iend,k)        = qv0_inv(:iend,k_inv)
         379           0 :        ql0(:iend,k)        = ql0_inv(:iend,k_inv)
         380           0 :        qi0(:iend,k)        = qi0_inv(:iend,k_inv)
         381           0 :        t0(:iend,k)         = t0_inv(:iend,k_inv)
         382           0 :        s0(:iend,k)         = s0_inv(:iend,k_inv)
         383           0 :        cldfrct(:iend,k)    = cldfrct_inv(:iend,k_inv)
         384           0 :        concldfrct(:iend,k) = concldfrct_inv(:iend,k_inv)
         385           0 :        do m = 1, ncnst
         386           0 :           tr0(:iend,k,m)   = tr0_inv(:iend,k_inv,m)
         387             :        enddo
         388             :     enddo
         389             :
         390           0 :     do k = 0, mkx
         391           0 :        k_inv               = mkx + 1 - k
         392           0 :        ps0(:iend,k)        = ps0_inv(:iend,k_inv)
         393           0 :        zs0(:iend,k)        = zs0_inv(:iend,k_inv)
         394           0 :        tke(:iend,k)        = tke_inv(:iend,k_inv)
         395             :     end do
         396             :
         397             :     call compute_uwshcu( mix  , mkx    , iend      , ncnst , dt   , &
         398             :                          ps0  , zs0    , p0        , z0    , dp0  , &
         399             :                          u0   , v0     , qv0       , ql0   , qi0  , &
         400             :                          t0   , s0     , tr0       ,                &
         401             :                          tke  , cldfrct, concldfrct, pblh  , cush , &
         402             :                          umf  , slflx  , qtflx     ,                &
         403             :                          flxprc1  , flxsnow1  ,                     &
         404             :                          qvten, qlten  , qiten     ,                &
         405             :                          sten , uten   , vten      , trten ,        &
         406             :                          qrten, qsten  , precip    , snow  , evapc, &
         407             :                          cufrc, qcu    , qlu       , qiu   ,        &
         408             :                          cbmf , qc     , rliq      ,                &
         409             :                          cnt  , cnb    , lchnk     , dpdry0,        &
         410           0 :                          fer_out, fdr_out                           )
         411             :
         412             :     ! Reverse cloud top/base interface indices
         413             :
         414           0 :        cnt_inv(:iend) = mkx + 1 - cnt(:iend)
         415           0 :        cnb_inv(:iend) = mkx + 1 - cnb(:iend)
         416             :
         417           0 :     do k = 0, mkx
         418           0 :        k_inv                  = mkx + 1 - k
         419           0 :        umf_inv(:iend,k_inv)   = umf(:iend,k)
         420           0 :        slflx_inv(:iend,k_inv) = slflx(:iend,k)
         421           0 :        qtflx_inv(:iend,k_inv) = qtflx(:iend,k)
         422           0 :        flxprc1_inv(:iend,k_inv) = flxprc1(:iend,k)     ! reversed for output to cam
         423           0 :        flxsnow1_inv(:iend,k_inv) = flxsnow1(:iend,k)   ! ""
         424             :     end do
         425             :
         426           0 :     do k = 1, mkx
         427           0 :        k_inv                         = mkx + 1 - k
         428           0 :        qvten_inv(:iend,k_inv)        = qvten(:iend,k)
         429           0 :        qlten_inv(:iend,k_inv)        = qlten(:iend,k)
         430           0 :        qiten_inv(:iend,k_inv)        = qiten(:iend,k)
         431           0 :        sten_inv(:iend,k_inv)         = sten(:iend,k)
         432           0 :        uten_inv(:iend,k_inv)         = uten(:iend,k)
         433           0 :        vten_inv(:iend,k_inv)         = vten(:iend,k)
         434           0 :        qrten_inv(:iend,k_inv)        = qrten(:iend,k)
         435           0 :        qsten_inv(:iend,k_inv)        = qsten(:iend,k)
         436           0 :        evapc_inv(:iend,k_inv)        = evapc(:iend,k)
         437           0 :        cufrc_inv(:iend,k_inv)        = cufrc(:iend,k)
         438           0 :        qcu_inv(:iend,k_inv)          = qcu(:iend,k)
         439           0 :        qlu_inv(:iend,k_inv)          = qlu(:iend,k)
         440           0 :        qiu_inv(:iend,k_inv)          = qiu(:iend,k)
         441           0 :        qc_inv(:iend,k_inv)           = qc(:iend,k)
         442           0 :        do m = 1, ncnst
         443           0 :           trten_inv(:iend,k_inv,m)   = trten(:iend,k,m)
         444             :        enddo
         445             :
         446             :     enddo
         447             :
         448           0 :     sh_e_ed_ratio(:iend,:) = -1.0_r8
         449           0 :     do k = 1, mkx
         450           0 :        do i = 1, iend
         451           0 :           if ( max(fer_out(i,k),fdr_out(i,k)) > 1.0e-10_r8) then
         452             :              sh_e_ed_ratio(i,k) = max(fer_out(i,k),0.0_r8) &
         453           0 :                                / (max(fer_out(i,k),0.0_r8) + max(fdr_out(i,k),0.0_r8))
         454             :           end if
         455             :        end do
         456             :     end do
         457             :
         458           0 :   end subroutine compute_uwshcu_inv
         459             :
         460           0 :   subroutine compute_uwshcu( mix      , mkx       , iend         , ncnst    , dt        , &
         461           0 :                              ps0_in   , zs0_in    , p0_in        , z0_in    , dp0_in    , &
         462           0 :                              u0_in    , v0_in     , qv0_in       , ql0_in   , qi0_in    , &
         463           0 :                              t0_in    , s0_in     , tr0_in       ,                        &
         464           0 :                              tke_in   , cldfrct_in, concldfrct_in,  pblh_in , cush_inout, &
         465           0 :                              umf_out  , slflx_out , qtflx_out    ,                        &
         466           0 :                              flxprc1_out  , flxsnow1_out  ,                               &
         467           0 :                              qvten_out, qlten_out , qiten_out    ,                        &
         468           0 :                              sten_out , uten_out  , vten_out     , trten_out,             &
         469           0 :                              qrten_out, qsten_out , precip_out   , snow_out , evapc_out , &
         470           0 :                              cufrc_out, qcu_out   , qlu_out      , qiu_out  ,             &
         471           0 :                              cbmf_out , qc_out    , rliq_out     ,                        &
         472           0 :                              cnt_out  , cnb_out   , lchnk        , dpdry0_in ,            &
         473           0 :                              fer_out  , fdr_out                                           )
         474             :
         475             :     ! ------------------------------------------------------------ !
         476             :     !                                                              !
         477             :     !  University of Washington Shallow Convection Scheme          !
         478             :     !                                                              !
         479             :     !  Described in Park and Bretherton. 2008. J. Climate :        !
         480             :     !                                                              !
         481             :     ! 'The University of Washington shallow convection and         !
         482             :     !  moist turbulent schemes and their impact on climate         !
         483             :     !  simulations with the Community Atmosphere Model'            !
         484             :     !                                                              !
         485             :     !  Coded by Sungsu Park. Oct.2005.                             !
         486             :     !                        May.2008.                             !
         487             :     !  For questions, send an email to sungsup@ucar.edu or         !
         488             :     !                                  sungsu@atmos.washington.edu !
         489             :     !                                                              !
         490             :     ! ------------------------------------------------------------ !
         491             :
         492             :     use cam_history,     only : outfld
         493             :     use constituents,    only : qmin, cnst_get_type_byind, cnst_get_ind
         494             :     use wv_saturation,   only : findsp_vc
         495             :
         496             :     implicit none
         497             :
         498             :     ! ---------------------- !
         499             :     ! Input-Output Variables !
         500             :     ! ---------------------- !
         501             :
         502             :     integer , intent(in)    :: lchnk
         503             :     integer , intent(in)    :: mix
         504             :     integer , intent(in)    :: mkx
         505             :     integer , intent(in)    :: iend
         506             :     integer , intent(in)    :: ncnst
         507             :     real(r8), intent(in)    :: dt                             !  Time step : 2*delta_t [ s ]
         508             :     real(r8), intent(in)    :: ps0_in(mix,0:mkx)              !  Environmental pressure at the interfaces [ Pa ]
         509             :     real(r8), intent(in)    :: zs0_in(mix,0:mkx)              !  Environmental height at the interfaces [ m ]
         510             :     real(r8), intent(in)    :: p0_in(mix,mkx)                 !  Environmental pressure at the layer mid-point [ Pa ]
         511             :     real(r8), intent(in)    :: z0_in(mix,mkx)                 !  Environmental height at the layer mid-point [ m ]
         512             :     real(r8), intent(in)    :: dp0_in(mix,mkx)                !  Environmental layer pressure thickness [ Pa ] > 0.
         513             :     real(r8), intent(in)    :: dpdry0_in(mix,mkx)             !  Environmental dry layer pressure thickness [ Pa ]
         514             :     real(r8), intent(in)    :: u0_in(mix,mkx)                 !  Environmental zonal wind [ m/s ]
         515             :     real(r8), intent(in)    :: v0_in(mix,mkx)                 !  Environmental meridional wind [ m/s ]
         516             :     real(r8), intent(in)    :: qv0_in(mix,mkx)                !  Environmental water vapor specific humidity [ kg/kg ]
         517             :     real(r8), intent(in)    :: ql0_in(mix,mkx)                !  Environmental liquid water specific humidity [ kg/kg ]
         518             :     real(r8), intent(in)    :: qi0_in(mix,mkx)                !  Environmental ice specific humidity [ kg/kg ]
         519             :     real(r8), intent(in)    :: t0_in(mix,mkx)                 !  Environmental temperature [ K ]
         520             :     real(r8), intent(in)    :: s0_in(mix,mkx)                 !  Environmental dry static energy [ J/kg ]
         521             :     real(r8), intent(in)    :: tr0_in(mix,mkx,ncnst)          !  Environmental tracers [ #, kg/kg ]
         522             :     real(r8), intent(in)    :: tke_in(mix,0:mkx)              !  Turbulent kinetic energy at the interfaces [ m2/s2 ]
         523             :     real(r8), intent(in)    :: cldfrct_in(mix,mkx)            !  Total cloud fraction at the previous time step [ fraction ]
         524             :     real(r8), intent(in)    :: concldfrct_in(mix,mkx)         !  Total convective cloud fraction
         525             :                                                               ! at the previous time step [ fraction ]
         526             :     real(r8), intent(in)    :: pblh_in(mix)                   !  Height of PBL [ m ]
         527             :     real(r8), intent(inout) :: cush_inout(mix)                !  Convective scale height [ m ]
         528             :
         529           0 :     real(r8)                   tw0_in(mix,mkx)                !  Wet bulb temperature [ K ]
         530           0 :     real(r8)                   qw0_in(mix,mkx)                !  Wet-bulb specific humidity [ kg/kg ]
         531             :
         532             :     real(r8), intent(out)   :: umf_out(mix,0:mkx)             !  Updraft mass flux at the interfaces [ kg/m2/s ]
         533             :     real(r8), intent(out)   :: qvten_out(mix,mkx)             !  Tendency of water vapor specific humidity [ kg/kg/s ]
         534             :     real(r8), intent(out)   :: qlten_out(mix,mkx)             !  Tendency of liquid water specific humidity [ kg/kg/s ]
         535             :     real(r8), intent(out)   :: qiten_out(mix,mkx)             !  Tendency of ice specific humidity [ kg/kg/s ]
         536             :     real(r8), intent(out)   :: sten_out(mix,mkx)              !  Tendency of dry static energy [ J/kg/s ]
         537             :     real(r8), intent(out)   :: uten_out(mix,mkx)              !  Tendency of zonal wind [ m/s2 ]
         538             :     real(r8), intent(out)   :: vten_out(mix,mkx)              !  Tendency of meridional wind [ m/s2 ]
         539             :     real(r8), intent(out)   :: trten_out(mix,mkx,ncnst)       !  Tendency of tracers [ #/s, kg/kg/s ]
         540             :     real(r8), intent(out)   :: qrten_out(mix,mkx)             !  Tendency of rain water specific humidity [ kg/kg/s ]
         541             :     real(r8), intent(out)   :: qsten_out(mix,mkx)             !  Tendency of snow specific humidity [ kg/kg/s ]
         542             :     real(r8), intent(out)   :: precip_out(mix)                !  Precipitation ( rain + snow ) rate at surface [ m/s ]
         543             :     real(r8), intent(out)   :: snow_out(mix)                  !  Snow rate at surface [ m/s ]
         544             :     real(r8), intent(out)   :: evapc_out(mix,mkx)             !  Tendency of evaporation of precipitation [ kg/kg/s ]
         545             :     real(r8), intent(out)   :: slflx_out(mix,0:mkx)           !  Updraft/pen.entrainment liquid static energy flux
         546             :                                                               ! [ J/kg * kg/m2/s ]
         547             :     real(r8), intent(out)   :: qtflx_out(mix,0:mkx)           !  updraft/pen.entrainment total water flux [ kg/kg * kg/m2/s ]
         548             :     real(r8), intent(out)   :: flxprc1_out(mix,0:mkx)         ! precip (rain+snow) flux
         549             :     real(r8), intent(out)   :: flxsnow1_out(mix,0:mkx)        ! snow flux
         550             :     real(r8), intent(out)   :: cufrc_out(mix,mkx)             !  Shallow cumulus cloud fraction at the layer mid-point [ fraction ]
         551             :     real(r8), intent(out)   :: qcu_out(mix,mkx)               !  Condensate water specific humidity within cumulus updraft [ kg/kg ]
         552             :     real(r8), intent(out)   :: qlu_out(mix,mkx)               !  Liquid water specific humidity within cumulus updraft [ kg/kg ]
         553             :     real(r8), intent(out)   :: qiu_out(mix,mkx)               !  Ice specific humidity within cumulus updraft [ kg/kg ]
         554             :     real(r8), intent(out)   :: cbmf_out(mix)                  !  Cloud base mass flux [ kg/m2/s ]
         555             :     real(r8), intent(out)   :: qc_out(mix,mkx)                !  Tendency of detrained cumulus condensate
         556             :                                                               ! into the environment [ kg/kg/s ]
         557             :     real(r8), intent(out)   :: rliq_out(mix)                  !  Vertical integral of qc_out [ m/s ]
         558             :     real(r8), intent(out)   :: cnt_out(mix)                   !  Cumulus top  interface index, cnt = kpen [ no ]
         559             :     real(r8), intent(out)   :: cnb_out(mix)                   !  Cumulus base interface index, cnb = krel - 1 [ no ]
         560             :     real(r8), intent(out)   :: fer_out(mix,mkx)               !  Fractional lateral entrainment rate [ 1/Pa ]
         561             :     real(r8), intent(out)   :: fdr_out(mix,mkx)               !  Fractional lateral detrainment rate [ 1/Pa ]
         562             :
         563             :     !
         564             :     ! Internal Output Variables
         565             :     !
         566             :
         567           0 :     real(r8)                   qtten_out(mix,mkx)             !  Tendency of qt [ kg/kg/s ]
         568           0 :     real(r8)                   slten_out(mix,mkx)             !  Tendency of sl [ J/kg/s ]
         569           0 :     real(r8)                   ufrc_out(mix,0:mkx)            !  Updraft fractional area at the interfaces [ fraction ]
         570           0 :     real(r8)                   uflx_out(mix,0:mkx)            !  Updraft/pen.entrainment zonal momentum flux [ m/s/m2/s ]
         571           0 :     real(r8)                   vflx_out(mix,0:mkx)            !  Updraft/pen.entrainment meridional momentum flux [ m/s/m2/s ]
         572           0 :     real(r8)                   cinh_out(mix)                  !  Convective INhibition upto LFC (CIN) [ J/kg ]
         573           0 :     real(r8)                   trflx_out(mix,0:mkx,ncnst)     !  Updraft/pen.entrainment tracer flux [ #/m2/s, kg/kg/m2/s ]
         574             :
         575             :     ! -------------------------------------------- !
         576             :     ! One-dimensional variables at each grid point !
         577             :     ! -------------------------------------------- !
         578             :
         579             :     ! 1. Input variables
         580             :
         581           0 :     real(r8)    ps0(0:mkx)                                    !  Environmental pressure at the interfaces [ Pa ]
         582           0 :     real(r8)    zs0(0:mkx)                                    !  Environmental height at the interfaces [ m ]
         583           0 :     real(r8)    p0(mkx)                                       !  Environmental pressure at the layer mid-point [ Pa ]
         584           0 :     real(r8)    z0(mkx)                                       !  Environmental height at the layer mid-point [ m ]
         585           0 :     real(r8)    dp0(mkx)                                      !  Environmental layer pressure thickness [ Pa ] > 0.
         586           0 :     real(r8)    dpdry0(mkx)                                   !  Environmental dry layer pressure thickness [ Pa ]
         587           0 :     real(r8)    u0(mkx)                                       !  Environmental zonal wind [ m/s ]
         588           0 :     real(r8)    v0(mkx)                                       !  Environmental meridional wind [ m/s ]
         589           0 :     real(r8)    tke(0:mkx)                                    !  Turbulent kinetic energy at the interfaces [ m2/s2 ]
         590           0 :     real(r8)    cldfrct(mkx)                                  !  Total cloud fraction at the previous time step [ fraction ]
         591           0 :     real(r8)    concldfrct(mkx)                               !  Total convective cloud fraction
         592             :                                                               !  at the previous time step [ fraction ]
         593           0 :     real(r8)    qv0(mkx)                                      !  Environmental water vapor specific humidity [ kg/kg ]
         594           0 :     real(r8)    ql0(mkx)                                      !  Environmental liquid water specific humidity [ kg/kg ]
         595           0 :     real(r8)    qi0(mkx)                                      !  Environmental ice specific humidity [ kg/kg ]
         596           0 :     real(r8)    t0(mkx)                                       !  Environmental temperature [ K ]
         597           0 :     real(r8)    s0(mkx)                                       !  Environmental dry static energy [ J/kg ]
         598             :     real(r8)    pblh                                          !  Height of PBL [ m ]
         599             :     real(r8)    cush                                          !  Convective scale height [ m ]
         600           0 :     real(r8)    tr0(mkx,ncnst)                                !  Environmental tracers [ #, kg/kg ]
         601             :
         602             :     ! 2. Environmental variables directly derived from the input variables
         603             :
         604           0 :     real(r8)    qt0(mkx)                                      !  Environmental total specific humidity [ kg/kg ]
         605           0 :     real(r8)    thl0(mkx)                                     !  Environmental liquid potential temperature [ K ]
         606           0 :     real(r8)    thvl0(mkx)                                    !  Environmental liquid virtual potential temperature [ K ]
         607           0 :     real(r8)    ssqt0(mkx)                                    !  Linear internal slope
         608             :                                                               !  of environmental total specific humidity [ kg/kg/Pa ]
         609           0 :     real(r8)    ssthl0(mkx)                                   !  Linear internal slope
         610             :                                                               ! of environmental liquid potential temperature [ K/Pa ]
         611           0 :     real(r8)    ssu0(mkx)                                     !  Linear internal slope of environmental zonal wind [ m/s/Pa ]
         612           0 :     real(r8)    ssv0(mkx)                                     !  Linear internal slope of environmental meridional wind [ m/s/Pa ]
         613           0 :     real(r8)    thv0bot(mkx)                                  !  Environmental virtual potential temperature
         614             :                                                               ! at the bottom of each layer [ K ]
         615           0 :     real(r8)    thv0top(mkx)                                  !  Environmental virtual potential temperature
         616             :                                                               ! at the top of each layer [ K ]
         617           0 :     real(r8)    thvl0bot(mkx)                                 !  Environmental liquid virtual potential temperature
         618             :                                                               ! at the bottom of each layer [ K ]
         619           0 :     real(r8)    thvl0top(mkx)                                 !  Environmental liquid virtual potential temperature
         620             :                                                               ! at the top of each layer [ K ]
         621           0 :     real(r8)    exn0(mkx)                                     !  Exner function at the layer mid points [ no ]
         622           0 :     real(r8)    exns0(0:mkx)                                  !  Exner function at the interfaces [ no ]
         623           0 :     real(r8)    sstr0(mkx,ncnst)                              !  Linear slope of environmental tracers [ #/Pa, kg/kg/Pa ]
         624             :
         625             :    ! 2-1. For preventing negative condensate at the provisional time step
         626             :
         627           0 :     real(r8)    qv0_star(mkx)                                 !  Environmental water vapor specific humidity [ kg/kg ]
         628           0 :     real(r8)    ql0_star(mkx)                                 !  Environmental liquid water specific humidity [ kg/kg ]
         629           0 :     real(r8)    qi0_star(mkx)                                 !  Environmental ice specific humidity [ kg/kg ]
         630             :     real(r8)    t0_star(mkx)                                  !  Environmental temperature [ K ]
         631           0 :     real(r8)    s0_star(mkx)                                  !  Environmental dry static energy [ J/kg ]
         632             :
         633             :    ! 3. Variables associated with cumulus convection
         634             :
         635           0 :     real(r8)    umf(0:mkx)                                    !  Updraft mass flux at the interfaces [ kg/m2/s ]
         636           0 :     real(r8)    emf(0:mkx)                                    !  Penetrative entrainment mass flux at the interfaces [ kg/m2/s ]
         637           0 :     real(r8)    qvten(mkx)                                    !  Tendency of water vapor specific humidity [ kg/kg/s ]
         638           0 :     real(r8)    qlten(mkx)                                    !  Tendency of liquid water specific humidity [ kg/kg/s ]
         639           0 :     real(r8)    qiten(mkx)                                    !  Tendency of ice specific humidity [ kg/kg/s ]
         640           0 :     real(r8)    sten(mkx)                                     !  Tendency of dry static energy [ J/kg ]
         641           0 :     real(r8)    uten(mkx)                                     !  Tendency of zonal wind [ m/s2 ]
         642           0 :     real(r8)    vten(mkx)                                     !  Tendency of meridional wind [ m/s2 ]
         643           0 :     real(r8)    qrten(mkx)                                    !  Tendency of rain water specific humidity [ kg/kg/s ]
         644           0 :     real(r8)    qsten(mkx)                                    !  Tendency of snow specific humidity [ kg/kg/s ]
         645             :     real(r8)    precip                                        !  Precipitation rate ( rain + snow) at the surface [ m/s ]
         646             :     real(r8)    snow                                          !  Snow rate at the surface [ m/s ]
         647           0 :     real(r8)    evapc(mkx)                                    !  Tendency of evaporation of precipitation [ kg/kg/s ]
         648           0 :     real(r8)    slflx(0:mkx)                                  !  Updraft/pen.entrainment liquid static energy flux
         649             :                                                               ! [ J/kg * kg/m2/s ]
         650           0 :     real(r8)    qtflx(0:mkx)                                  !  Updraft/pen.entrainment total water flux [ kg/kg * kg/m2/s ]
         651           0 :     real(r8)    uflx(0:mkx)                                   !  Updraft/pen.entrainment flux of zonal momentum [ m/s/m2/s ]
         652           0 :     real(r8)    vflx(0:mkx)                                   !  Updraft/pen.entrainment flux of meridional momentum [ m/s/m2/s ]
         653           0 :     real(r8)    cufrc(mkx)                                    !  Shallow cumulus cloud fraction at the layer mid-point [ fraction ]
         654           0 :     real(r8)    qcu(mkx)                                      !  Condensate water specific humidity
         655             :                                                               ! within convective updraft [ kg/kg ]
         656           0 :     real(r8)    qlu(mkx)                                      !  Liquid water specific humidity within convective updraft [ kg/kg ]
         657           0 :     real(r8)    qiu(mkx)                                      !  Ice specific humidity within convective updraft [ kg/kg ]
         658           0 :     real(r8)    dwten(mkx)                                    !  Detrained water tendency from cumulus updraft [ kg/kg/s ]
         659           0 :     real(r8)    diten(mkx)                                    !  Detrained ice   tendency from cumulus updraft [ kg/kg/s ]
         660           0 :     real(r8)    fer(mkx)                                      !  Fractional lateral entrainment rate [ 1/Pa ]
         661           0 :     real(r8)    fdr(mkx)                                      !  Fractional lateral detrainment rate [ 1/Pa ]
         662           0 :     real(r8)    uf(mkx)                                       !  Zonal wind at the provisional time step [ m/s ]
         663           0 :     real(r8)    vf(mkx)                                       !  Meridional wind at the provisional time step [ m/s ]
         664           0 :     real(r8)    qc(mkx)                                       !  Tendency due to detrained 'cloud water + cloud ice'
         665             :                                                               ! (without rain-snow contribution) [ kg/kg/s ]
         666           0 :     real(r8)    qc_l(mkx)                                     !  Tendency due to detrained 'cloud water'
         667             :                                                               ! (without rain-snow contribution) [ kg/kg/s ]
         668           0 :     real(r8)    qc_i(mkx)                                     !  Tendency due to detrained 'cloud ice'
         669             :                                                               ! (without rain-snow contribution) [ kg/kg/s ]
         670             :     real(r8)    qc_lm
         671             :     real(r8)    qc_im
         672             :     real(r8)    nc_lm
         673             :     real(r8)    nc_im
         674             :     real(r8)    ql_emf_kbup
         675             :     real(r8)    qi_emf_kbup
         676             :     real(r8)    nl_emf_kbup
         677             :     real(r8)    ni_emf_kbup
         678             :     real(r8)    qlten_det
         679             :     real(r8)    qiten_det
         680             :     real(r8)    rliq                                          !  Vertical integral of qc [ m/s ]
         681             :     real(r8)    cnt                                           !  Cumulus top  interface index, cnt = kpen [ no ]
         682             :     real(r8)    cnb                                           !  Cumulus base interface index, cnb = krel - 1 [ no ]
         683           0 :     real(r8)    qtten(mkx)                                    !  Tendency of qt [ kg/kg/s ]
         684           0 :     real(r8)    slten(mkx)                                    !  Tendency of sl [ J/kg/s ]
         685           0 :     real(r8)    ufrc(0:mkx)                                   !  Updraft fractional area [ fraction ]
         686           0 :     real(r8)    trten(mkx,ncnst)                              !  Tendency of tracers [ #/s, kg/kg/s ]
         687           0 :     real(r8)    trflx(0:mkx,ncnst)                            !  Flux of tracers due to convection [ # * kg/m2/s, kg/kg * kg/m2/s ]
         688           0 :     real(r8)    trflx_d(0:mkx)                                !  Adjustive downward flux of tracers to prevent negative tracers
         689           0 :     real(r8)    trflx_u(0:mkx)                                !  Adjustive upward   flux of tracers to prevent negative tracers
         690             :     real(r8)    trmin                                         !  Minimum concentration of tracers allowed
         691             :     real(r8)    pdelx, dum
         692             :
         693             :     !----- Variables used for the calculation of condensation sink associated with compensating subsidence
         694             :     !      In the current code, this 'sink' tendency is simply set to be zero.
         695             :
         696           0 :     real(r8)    uemf(0:mkx)                                   !  Net updraft mass flux at the interface ( emf + umf ) [ kg/m2/s ]
         697           0 :     real(r8)    comsub(mkx)                                   !  Compensating subsidence
         698             :                                                               ! at the layer mid-point ( unit of mass flux, umf ) [ kg/m2/s ]
         699           0 :     real(r8)    qlten_sink(mkx)                               !  Liquid condensate tendency
         700             :                                                               ! by compensating subsidence/upwelling [ kg/kg/s ]
         701           0 :     real(r8)    qiten_sink(mkx)                               !  Ice    condensate tendency
         702             :                                                               ! by compensating subsidence/upwelling [ kg/kg/s ]
         703           0 :     real(r8)    nlten_sink(mkx)                               !  Liquid droplets # tendency
         704             :                                                               ! by compensating subsidence/upwelling [ kg/kg/s ]
         705           0 :     real(r8)    niten_sink(mkx)                               !  Ice    droplets # tendency
         706             :                                                               ! by compensating subsidence/upwelling [ kg/kg/s ]
         707             :     real(r8)    thlten_sub, qtten_sub                         !  Tendency of conservative scalars
         708             :                                                               ! by compensating subsidence/upwelling
         709             :     real(r8)    qlten_sub, qiten_sub                          !  Tendency of ql0, qi0
         710             :                                                               ! by compensating subsidence/upwelling
         711             :     real(r8)    nlten_sub, niten_sub                          !  Tendency of nl0, ni0
         712             :                                                               ! by compensating subsidence/upwelling
         713             :     real(r8)    thl_prog, qt_prog                             !  Prognosed 'thl, qt'
         714             :                                                               ! by compensating subsidence/upwelling
         715             :
         716             :     !----- Variables describing cumulus updraft
         717             :
         718           0 :     real(r8)    wu(0:mkx)                                     !  Updraft vertical velocity at the interface [ m/s ]
         719           0 :     real(r8)    thlu(0:mkx)                                   !  Updraft liquid potential temperature at the interface [ K ]
         720           0 :     real(r8)    qtu(0:mkx)                                    !  Updraft total specific humidity at the interface [ kg/kg ]
         721           0 :     real(r8)    uu(0:mkx)                                     !  Updraft zonal wind at the interface [ m/s ]
         722           0 :     real(r8)    vu(0:mkx)                                     !  Updraft meridional wind at the interface [ m/s ]
         723           0 :     real(r8)    thvu(0:mkx)                                   !  Updraft virtual potential temperature at the interface [ m/s ]
         724           0 :     real(r8)    rei(mkx)                                      !  Updraft fractional mixing rate with the environment [ 1/Pa ]
         725           0 :     real(r8)    tru(0:mkx,ncnst)                              !  Updraft tracers [ #, kg/kg ]
         726             :
         727             :     !----- Variables describing conservative scalars of entraining downdrafts  at the
         728             :     !      entraining interfaces, i.e., 'kbup <= k < kpen-1'. At the other interfaces,
         729             :     !      belows are simply set to equal to those of updraft for simplicity - but it
         730             :     !      does not influence numerical calculation.
         731             :
         732           0 :     real(r8)    thlu_emf(0:mkx)                               !  Penetrative downdraft liquid potential temperature
         733             :                                                               ! at entraining interfaces [ K ]
         734           0 :     real(r8)    qtu_emf(0:mkx)                                !  Penetrative downdraft total water
         735             :                                                               ! at entraining interfaces [ kg/kg ]
         736           0 :     real(r8)    uu_emf(0:mkx)                                 !  Penetrative downdraft zonal wind
         737             :                                                               ! at entraining interfaces [ m/s ]
         738           0 :     real(r8)    vu_emf(0:mkx)                                 !  Penetrative downdraft meridional wind
         739             :                                                               ! at entraining interfaces [ m/s ]
         740           0 :     real(r8)    tru_emf(0:mkx,ncnst)                          !  Penetrative Downdraft tracers
         741             :                                                               ! at entraining interfaces [ #, kg/kg ]
         742             :
         743             :     !----- Variables associated with evaporations of convective 'rain' and 'snow'
         744             :
         745           0 :     real(r8)    flxrain(0:mkx)                                !  Downward rain flux at each interface [ kg/m2/s ]
         746           0 :     real(r8)    flxsnow(0:mkx)                                !  Downward snow flux at each interface [ kg/m2/s ]
         747           0 :     real(r8)    ntraprd(mkx)                                  !  Net production ( production - evaporation +  melting )
         748             :                                                               ! rate of rain in each layer [ kg/kg/s ]
         749           0 :     real(r8)    ntsnprd(mkx)                                  !  Net production ( production - evaporation + freezing )
         750             :                                                               ! rate of snow in each layer [ kg/kg/s ]
         751             :     real(r8)    flxsntm                                       !  Downward snow flux
         752             :                                                               ! at the top of each layer after melting [ kg/m2/s ]
         753             :     real(r8)    snowmlt                                       !  Snow melting tendency [ kg/kg/s ]
         754             :     real(r8)    subsat                                        !  Sub-saturation ratio (1-qv/qs) [ no unit ]
         755             :     real(r8)    evprain                                       !  Evaporation rate of rain [ kg/kg/s ]
         756             :     real(r8)    evpsnow                                       !  Evaporation rate of snow [ kg/kg/s ]
         757             :     real(r8)    evplimit                                      !  Limiter of 'evprain + evpsnow' [ kg/kg/s ]
         758             :     real(r8)    evplimit_rain                                 !  Limiter of 'evprain' [ kg/kg/s ]
         759             :     real(r8)    evplimit_snow                                 !  Limiter of 'evpsnow' [ kg/kg/s ]
         760             :     real(r8)    evpint_rain                                   !  Vertically-integrated evaporative flux of rain [ kg/m2/s ]
         761             :     real(r8)    evpint_snow                                   !  Vertically-integrated evaporative flux of snow [ kg/m2/s ]
         762             :     real(r8)    kevp                                          !  Evaporative efficiency [ complex unit ]
         763             :
         764             :     !----- Other internal variables
         765             :
         766             :     integer     kk, mm, k, i, m, kp1, km1
         767             :     integer     iter_scaleh, iter_xc
         768             :     integer     id_check, status
         769             :     integer     klcl                                          !  Layer containing LCL of source air
         770             :     integer     kinv                                          !  Inversion layer with PBL top interface as a lower interface
         771             :     integer     krel                                          !  Release layer where buoyancy sorting mixing
         772             :                                                               ! occurs for the first time
         773             :     integer     klfc                                          !  LFC layer of cumulus source air
         774             :     integer     kbup                                          !  Top layer in which cloud buoyancy is positive at the top interface
         775             :     integer     kpen                                          !  Highest layer with positive updraft vertical velocity
         776             :                                                               ! - top layer cumulus can reach
         777             :     logical     id_exit
         778             :     logical     forcedCu                                      !  If 'true', cumulus updraft cannot overcome the buoyancy barrier
         779             :                                                               ! just above the PBL top.
         780             :     real(r8)    thlsrc, qtsrc, usrc, vsrc, thvlsrc            !  Updraft source air properties
         781             :     real(r8)    PGFc, uplus, vplus
         782           0 :     real(r8)    trsrc(ncnst), tre(ncnst)
         783             :     real(r8)    plcl, plfc, prel, wrel
         784             :     real(r8)    frc_rasn
         785             :     real(r8)    ee2, ud2, wtw, wtwb, wtwh
         786             :     real(r8)    xc, xc_2
         787             :     real(r8)    cldhgt, scaleh, tscaleh, cridis, rle, rkm
         788             :     real(r8)    rkfre, sigmaw, epsvarw, tkeavg, dpsum, dpi, thvlmin
         789             :     real(r8)    thlxsat, qtxsat, thvxsat, x_cu, x_en, thv_x0, thv_x1
         790             :     real(r8)    thj, qvj, qlj, qij, thvj, tj, thv0j, rho0j, rhos0j, qse
         791             :     real(r8)    cin, cinlcl
         792             :     real(r8)    pe, dpe, exne, thvebot, thle, qte, ue, ve, thlue, qtue, wue
         793             :     real(r8)    mu, mumin0, mumin1, mumin2, mulcl, mulclstar
         794             :     real(r8)    cbmf, wcrit, winv, wlcl, ufrcinv, ufrclcl, rmaxfrac
         795             :     real(r8)    criqc, exql, exqi, ppen
         796             :     real(r8)    thl0top, thl0bot, qt0bot, qt0top, thvubot, thvutop
         797             :     real(r8)    thlu_top, qtu_top, qlu_top, qiu_top, qlu_mid, qiu_mid, exntop
         798             :     real(r8)    thl0lcl, qt0lcl, thv0lcl, thv0rel, rho0inv, autodet
         799             :     real(r8)    aquad, bquad, cquad, xc1, xc2, excessu, excess0, xsat, xs1, xs2
         800             :     real(r8)    bogbot, bogtop, delbog, drage, expfac, rbuoy, rdrag
         801             :     real(r8)    rcwp, rlwp, riwp, qcubelow, qlubelow, qiubelow
         802             :     real(r8)    rainflx, snowflx
         803             :     real(r8)    es
         804             :     real(r8)    qs
         805             :     real(r8)    qsat_arg
         806           0 :     real(r8)    xsrc, xmean, xtop, xbot, xflx(0:mkx)
         807             :     real(r8)    tmp1, tmp2
         808             :
         809             :     !----- Some diagnostic internal output variables
         810             :
         811           0 :     real(r8)  ufrcinvbase_out(mix)                            !  Cumulus updraft fraction at the PBL top [ fraction ]
         812           0 :     real(r8)  ufrclcl_out(mix)                                !  Cumulus updraft fraction at the LCL
         813             :                                                               ! ( or PBL top when LCL is below PBL top ) [ fraction ]
         814           0 :     real(r8)  winvbase_out(mix)                               !  Cumulus updraft velocity at the PBL top [ m/s ]
         815           0 :     real(r8)  wlcl_out(mix)                                   !  Cumulus updraft velocity at the LCL
         816             :                                                               ! ( or PBL top when LCL is below PBL top ) [ m/s ]
         817           0 :     real(r8)  plcl_out(mix)                                   !  LCL of source air [ Pa ]
         818           0 :     real(r8)  pinv_out(mix)                                   !  PBL top pressure [ Pa ]
         819           0 :     real(r8)  plfc_out(mix)                                   !  LFC of source air [ Pa ]
         820           0 :     real(r8)  pbup_out(mix)                                   !  Highest interface level of positive buoyancy [ Pa ]
         821           0 :     real(r8)  ppen_out(mix)                                   !  Highest interface evel where Cu w = 0 [ Pa ]
         822           0 :     real(r8)  qtsrc_out(mix)                                  !  Sourse air qt [ kg/kg ]
         823           0 :     real(r8)  thlsrc_out(mix)                                 !  Sourse air thl [ K ]
         824           0 :     real(r8)  thvlsrc_out(mix)                                !  Sourse air thvl [ K ]
         825           0 :     real(r8)  emfkbup_out(mix)                                !  Penetrative downward mass flux at 'kbup' interface [ kg/m2/s ]
         826           0 :     real(r8)  cinlclh_out(mix)                                !  Convective INhibition upto LCL (CIN) [ J/kg = m2/s2 ]
         827           0 :     real(r8)  tkeavg_out(mix)                                 !  Average tke over the PBL [ m2/s2 ]
         828           0 :     real(r8)  cbmflimit_out(mix)                              !  Cloud base mass flux limiter [ kg/m2/s ]
         829           0 :     real(r8)  zinv_out(mix)                                   !  PBL top height [ m ]
         830           0 :     real(r8)  rcwp_out(mix)                                   !  Layer mean Cumulus LWP+IWP [ kg/m2 ]
         831           0 :     real(r8)  rlwp_out(mix)                                   !  Layer mean Cumulus LWP [ kg/m2 ]
         832           0 :     real(r8)  riwp_out(mix)                                   !  Layer mean Cumulus IWP [ kg/m2 ]
         833           0 :     real(r8)  wu_out(mix,0:mkx)                               !  Updraft vertical velocity
         834             :                                                               ! ( defined from the release level to 'kpen-1' interface )
         835           0 :     real(r8)  qtu_out(mix,0:mkx)                              !  Updraft qt [ kg/kg ]
         836           0 :     real(r8)  thlu_out(mix,0:mkx)                             !  Updraft thl [ K ]
         837           0 :     real(r8)  thvu_out(mix,0:mkx)                             !  Updraft thv [ K ]
         838           0 :     real(r8)  uu_out(mix,0:mkx)                               !  Updraft zonal wind [ m/s ]
         839           0 :     real(r8)  vu_out(mix,0:mkx)                               !  Updraft meridional wind [ m/s ]
         840           0 :     real(r8)  qtu_emf_out(mix,0:mkx)                          !  Penetratively entrained qt [ kg/kg ]
         841           0 :     real(r8)  thlu_emf_out(mix,0:mkx)                         !  Penetratively entrained thl [ K ]
         842           0 :     real(r8)  uu_emf_out(mix,0:mkx)                           !  Penetratively entrained u [ m/s ]
         843           0 :     real(r8)  vu_emf_out(mix,0:mkx)                           !  Penetratively entrained v [ m/s ]
         844           0 :     real(r8)  uemf_out(mix,0:mkx)                             !  Net upward mass flux
         845             :                                                               ! including penetrative entrainment (umf+emf) [ kg/m2/s ]
         846           0 :     real(r8)  tru_out(mix,0:mkx,ncnst)                        !  Updraft tracers [ #, kg/kg ]
         847           0 :     real(r8)  tru_emf_out(mix,0:mkx,ncnst)                    !  Penetratively entrained tracers [ #, kg/kg ]
         848             :
         849           0 :     real(r8)  wu_s(0:mkx)                                     !  Same as above but for implicit CIN
         850           0 :     real(r8)  qtu_s(0:mkx)
         851           0 :     real(r8)  thlu_s(0:mkx)
         852           0 :     real(r8)  thvu_s(0:mkx)
         853           0 :     real(r8)  uu_s(0:mkx)
         854           0 :     real(r8)  vu_s(0:mkx)
         855           0 :     real(r8)  qtu_emf_s(0:mkx)
         856           0 :     real(r8)  thlu_emf_s(0:mkx)
         857           0 :     real(r8)  uu_emf_s(0:mkx)
         858           0 :     real(r8)  vu_emf_s(0:mkx)
         859           0 :     real(r8)  uemf_s(0:mkx)
         860           0 :     real(r8)  tru_s(0:mkx,ncnst)
         861           0 :     real(r8)  tru_emf_s(0:mkx,ncnst)
         862             :
         863           0 :     real(r8)  dwten_out(mix,mkx)
         864           0 :     real(r8)  diten_out(mix,mkx)
         865           0 :     real(r8)  flxrain_out(mix,0:mkx)
         866           0 :     real(r8)  flxsnow_out(mix,0:mkx)
         867           0 :     real(r8)  ntraprd_out(mix,mkx)
         868           0 :     real(r8)  ntsnprd_out(mix,mkx)
         869             :
         870           0 :     real(r8)  dwten_s(mkx)
         871           0 :     real(r8)  diten_s(mkx)
         872           0 :     real(r8)  flxrain_s(0:mkx)
         873           0 :     real(r8)  flxsnow_s(0:mkx)
         874           0 :     real(r8)  ntraprd_s(mkx)
         875           0 :     real(r8)  ntsnprd_s(mkx)
         876             :
         877           0 :     real(r8)  excessu_arr_out(mix,mkx)
         878           0 :     real(r8)  excessu_arr(mkx)
         879           0 :     real(r8)  excessu_arr_s(mkx)
         880           0 :     real(r8)  excess0_arr_out(mix,mkx)
         881           0 :     real(r8)  excess0_arr(mkx)
         882           0 :     real(r8)  excess0_arr_s(mkx)
         883           0 :     real(r8)  xc_arr_out(mix,mkx)
         884           0 :     real(r8)  xc_arr(mkx)
         885           0 :     real(r8)  xc_arr_s(mkx)
         886           0 :     real(r8)  aquad_arr_out(mix,mkx)
         887           0 :     real(r8)  aquad_arr(mkx)
         888           0 :     real(r8)  aquad_arr_s(mkx)
         889           0 :     real(r8)  bquad_arr_out(mix,mkx)
         890           0 :     real(r8)  bquad_arr(mkx)
         891           0 :     real(r8)  bquad_arr_s(mkx)
         892           0 :     real(r8)  cquad_arr_out(mix,mkx)
         893           0 :     real(r8)  cquad_arr(mkx)
         894           0 :     real(r8)  cquad_arr_s(mkx)
         895           0 :     real(r8)  bogbot_arr_out(mix,mkx)
         896           0 :     real(r8)  bogbot_arr(mkx)
         897           0 :     real(r8)  bogbot_arr_s(mkx)
         898           0 :     real(r8)  bogtop_arr_out(mix,mkx)
         899           0 :     real(r8)  bogtop_arr(mkx)
         900           0 :     real(r8)  bogtop_arr_s(mkx)
         901             :
         902           0 :     real(r8)  exit_UWCu(mix)
         903           0 :     real(r8)  exit_conden(mix)
         904           0 :     real(r8)  exit_klclmkx(mix)
         905           0 :     real(r8)  exit_klfcmkx(mix)
         906           0 :     real(r8)  exit_ufrc(mix)
         907           0 :     real(r8)  exit_wtw(mix)
         908           0 :     real(r8)  exit_drycore(mix)
         909           0 :     real(r8)  exit_wu(mix)
         910           0 :     real(r8)  exit_cufilter(mix)
         911           0 :     real(r8)  exit_kinv1(mix)
         912           0 :     real(r8)  exit_rei(mix)
         913             :
         914           0 :     real(r8)  limit_shcu(mix)
         915           0 :     real(r8)  limit_negcon(mix)
         916           0 :     real(r8)  limit_ufrc(mix)
         917           0 :     real(r8)  limit_ppen(mix)
         918           0 :     real(r8)  limit_emf(mix)
         919           0 :     real(r8)  limit_cinlcl(mix)
         920           0 :     real(r8)  limit_cin(mix)
         921           0 :     real(r8)  limit_cbmf(mix)
         922           0 :     real(r8)  limit_rei(mix)
         923           0 :     real(r8)  ind_delcin(mix)
         924             :
         925             :     real(r8) :: ufrcinvbase_s, ufrclcl_s, winvbase_s, wlcl_s, plcl_s, pinv_s, plfc_s, &
         926             :                 qtsrc_s, thlsrc_s, thvlsrc_s, emfkbup_s, cinlcl_s, pbup_s, ppen_s, cbmflimit_s, &
         927             :                 tkeavg_s, zinv_s, rcwp_s, rlwp_s, riwp_s
         928             :     real(r8) :: ufrcinvbase, winvbase, pinv, zinv, emfkbup, cbmflimit, rho0rel
         929             :
         930             :     !----- Variables for implicit CIN computation
         931             :
         932           0 :     real(r8), dimension(mkx)         :: qv0_s  , ql0_s   , qi0_s   , s0_s    , u0_s    ,           &
         933           0 :                                         v0_s   , t0_s    , qt0_s   , thl0_s  , thvl0_s , qvten_s , &
         934           0 :                                         qlten_s, qiten_s , qrten_s , qsten_s , sten_s  , evapc_s , &
         935           0 :                                         uten_s , vten_s  , cufrc_s , qcu_s   , qlu_s   , qiu_s   , &
         936           0 :                                         fer_s  , fdr_s   , qc_s    , qtten_s , slten_s
         937           0 :     real(r8), dimension(0:mkx)       :: umf_s  , slflx_s , qtflx_s , ufrc_s  , uflx_s , vflx_s
         938             :     real(r8)                         :: cush_s , precip_s, snow_s  , cin_s   , rliq_s, cbmf_s, cnt_s, cnb_s
         939             :     real(r8)                         :: cin_i,cin_f,del_CIN,ke,alpha,thlj
         940             :     real(r8)                         :: cinlcl_i,cinlcl_f,del_cinlcl
         941             :     integer                          :: iter
         942             :
         943           0 :     real(r8), dimension(mkx,ncnst)   :: tr0_s, trten_s
         944           0 :     real(r8), dimension(0:mkx,ncnst) :: trflx_s
         945             :
         946             :     !----- Variables for temporary storages
         947             :
         948           0 :     real(r8), dimension(mkx)         :: qv0_o, ql0_o, qi0_o, t0_o, s0_o, u0_o, v0_o
         949           0 :     real(r8), dimension(mkx)         :: qt0_o    , thl0_o   , thvl0_o   ,                         &
         950             :                                         qvten_o  , qlten_o  , qiten_o   , qrten_o   , qsten_o ,   &
         951             :                                         sten_o   , uten_o   , vten_o    , qcu_o     , qlu_o   ,   &
         952             :                                         qiu_o    , cufrc_o  , evapc_o   ,                         &
         953           0 :                                         thv0bot_o, thv0top_o, thvl0bot_o, thvl0top_o,             &
         954           0 :                                         ssthl0_o , ssqt0_o  , ssu0_o    , ssv0_o    , qc_o    ,   &
         955             :                                         qtten_o  , slten_o
         956             :     real(r8), dimension(0:mkx)       :: umf_o    , slflx_o  , qtflx_o   , ufrc_o
         957             :     real(r8), dimension(mix)         :: cush_o   , precip_o , snow_o    , rliq_o, cbmf_o, cnt_o, cnb_o
         958             :     real(r8), dimension(0:mkx)       :: uflx_o   , vflx_o
         959             :     real(r8)                         :: tkeavg_o , thvlmin_o, qtsrc_o  , thvlsrc_o, thlsrc_o ,    &
         960             :                                         usrc_o   , vsrc_o   , plcl_o   , plfc_o   ,               &
         961             :                                         thv0lcl_o, cinlcl_o
         962             :     integer                          :: kinv_o   , klcl_o   , klfc_o
         963             :
         964           0 :     real(r8), dimension(mkx,ncnst)   :: tr0_o
         965           0 :     real(r8), dimension(mkx,ncnst)   :: trten_o, sstr0_o
         966             :     real(r8), dimension(0:mkx,ncnst) :: trflx_o
         967           0 :     real(r8), dimension(ncnst)       :: trsrc_o
         968             :     integer                          :: ixnumliq, ixnumice, ixcldliq, ixcldice
         969             :
         970             :     ! ------------------ !
         971             :     !                    !
         972             :     ! Define Parameters  !
         973             :     !                    !
         974             :     ! ------------------ !
         975             :
         976             :     ! ------------------------ !
         977             :     ! Iterative xc calculation !
         978             :     ! ------------------------ !
         979             :
         980             :     integer , parameter              :: niter_xc = 2
         981             :
         982             :     ! ----------------------------------------------------------- !
         983             :     ! Choice of 'CIN = cin' (.true.) or 'CIN = cinlcl' (.false.). !
         984             :     !                                                             !
         985             :     ! Feb 2007, Bundy: Note that use_CINcin = .false. will try to !
         986             :     ! use a variable (del_cinlcl) that is not currently set       !
         987             :     !                                                             !
         988             :     ! Sept 2012, Santos: The fact that this is still true over 5  !
         989             :     ! years later suggests that this option needs to be           !
         990             :     ! fixed or abandoned.                                         !
         991             :     ! ----------------------------------------------------------- !
         992             :
         993             :     logical , parameter              :: use_CINcin = .true.
         994             :
         995             :     ! --------------------------------------------------------------- !
         996             :     ! Choice of 'explicit' ( 1 ) or 'implicit' ( 2 )  CIN.            !
         997             :     !                                                                 !
         998             :     ! When choose 'CIN = cinlcl' above,  it is recommended not to use !
         999             :     ! implicit CIN, i.e., do 'NOT' choose simultaneously :            !
        1000             :     !            [ 'use_CINcin=.false. & 'iter_cin=2' ]               !
        1001             :     ! since 'cinlcl' will be always set to zero whenever LCL is below !
        1002             :     ! the PBL top interface in the current code. So, averaging cinlcl !
        1003             :     ! of two iter_cin steps is likely not so good. Except that,   all !
        1004             :     ! the other combinations of  'use_CINcin'  & 'iter_cin' are OK.   !
        1005             :     ! --------------------------------------------------------------- !
        1006             :
        1007             :     integer , parameter              :: iter_cin = 2
        1008             :
        1009             :     ! ---------------------------------------------------------------- !
        1010             :     ! Choice of 'self-detrainment' by negative buoyancy in calculating !
        1011             :     ! cumulus updraft mass flux at the top interface in each layer.    !
        1012             :     ! ---------------------------------------------------------------- !
        1013             :
        1014             :     logical , parameter              :: use_self_detrain = .false.
        1015             :
        1016             :     ! --------------------------------------------------------- !
        1017             :     ! Cumulus momentum flux : turn-on (.true.) or off (.false.) !
        1018             :     ! --------------------------------------------------------- !
        1019             :
        1020             :     logical , parameter              :: use_momenflx = .true.
        1021             :
        1022             :     ! ----------------------------------------------------------------------------------------- !
        1023             :     ! Penetrative Entrainment : Cumulative ( .true. , original ) or Non-Cumulative ( .false. )  !
        1024             :     ! This option ( .false. ) is designed to reduce the sensitivity to the vertical resolution. !
        1025             :     ! ----------------------------------------------------------------------------------------- !
        1026             :
        1027             :     logical , parameter              :: use_cumpenent = .true.
        1028             :
        1029             :     ! --------------------------------------------------------------------------------------------------------------- !
        1030             :     ! Computation of the grid-mean condensate tendency.                                                               !
        1031             :     !     use_expconten = .true.  : explcitly compute tendency by condensate detrainment and compensating subsidence  !
        1032             :     !     use_expconten = .false. : use the original proportional condensate tendency equation. ( original )          !
        1033             :     ! --------------------------------------------------------------------------------------------------------------- !
        1034             :
        1035             :     logical , parameter              :: use_expconten = .true.
        1036             :
        1037             :     ! --------------------------------------------------------------------------------------------------------------- !
        1038             :     ! Treatment of reserved condensate                                                                                !
        1039             :     !     use_unicondet = .true.  : detrain condensate uniformly over the environment ( original )                    !
        1040             :     !     use_unicondet = .false. : detrain condensate into the pre-existing stratus                                  !
        1041             :     ! --------------------------------------------------------------------------------------------------------------- !
        1042             :
        1043             :     logical , parameter              :: use_unicondet = .false.
        1044             :
        1045             :     ! ----------------------- !
        1046             :     ! For lateral entrainment !
        1047             :     ! ----------------------- !
        1048             :
        1049             :     parameter (rle = 0.1_r8)         !  For critical stopping distance for lateral entrainment [no unit]
        1050             : !   parameter (rkm = 16.0_r8)        !  Determine the amount of air that is involved in buoyancy-sorting [no unit]
        1051             :     parameter (rkm = 14.0_r8)        !  Determine the amount of air that is involved in buoyancy-sorting [no unit]
        1052             :
        1053             :     parameter (rkfre = 1.0_r8)       !  Vertical velocity variance as fraction of  tke.
        1054             :     parameter (rmaxfrac = 0.10_r8)   !  Maximum allowable 'core' updraft fraction
        1055             :     parameter (mumin1 = 0.906_r8)    !  Normalized CIN ('mu') corresponding to 'rmaxfrac' at the PBL top
        1056             :                                      !  obtaind by inverting 'rmaxfrac = 0.5*erfc(mumin1)'.
        1057             :                                      !  [rmaxfrac:mumin1]=[ 0.05:1.163, 0.075:1.018, 0.1:0.906, 0.15:0.733, 0.2:0.595, 0.25:0.477]
        1058             :     parameter (rbuoy = 1.0_r8)       !  For nonhydrostatic pressure effects on updraft [no unit]
        1059             :     parameter (rdrag = 1.0_r8)       !  Drag coefficient [no unit]
        1060             :
        1061             :     parameter (epsvarw = 5.e-4_r8)   !  Variance of w at PBL top by meso-scale component [m2/s2]
        1062             :     parameter (PGFc = 0.7_r8)        !  This is used for calculating vertical variations cumulus
        1063             :                                      !  'u' & 'v' by horizontal PGF during upward motion [no unit]
        1064             :
        1065             :     ! ---------------------------------------- !
        1066             :     ! Bulk microphysics controlling parameters !
        1067             :     ! --------------------------------------------------------------------------- !
        1068             :     ! criqc    : Maximum condensate that can be hold by cumulus updraft [kg/kg]   !
        1069             :     ! frc_rasn : Fraction of precipitable condensate in the expelled cloud water  !
        1070             :     !            from cumulus updraft. The remaining fraction ('1-frc_rasn')  is  !
        1071             :     !            'suspended condensate'.                                          !
        1072             :     !                0 : all expelled condensate is 'suspended condensate'        !
        1073             :     !                1 : all expelled condensate is 'precipitable condensate'     !
        1074             :     ! kevp     : Evaporative efficiency                                           !
        1075             :     ! noevap_krelkpen : No evaporation from 'krel' to 'kpen' layers               !
        1076             :     ! --------------------------------------------------------------------------- !
        1077             :
        1078             :     parameter ( criqc    = 0.7e-3_r8 )
        1079             :     parameter ( frc_rasn = 1.0_r8    )
        1080             :     parameter ( kevp     = 2.e-6_r8  )
        1081             :     logical, parameter :: noevap_krelkpen = .false.
        1082             :
        1083             :     !------------------------!
        1084             :     !                        !
        1085             :     ! Start Main Calculation !
        1086             :     !                        !
        1087             :     !------------------------!
        1088             :
        1089           0 :     call cnst_get_ind( 'NUMLIQ', ixnumliq )
        1090           0 :     call cnst_get_ind( 'NUMICE', ixnumice )
        1091             :
        1092           0 :     call cnst_get_ind( 'CLDLIQ', ixcldliq )
        1093           0 :     call cnst_get_ind( 'CLDICE', ixcldice )
        1094             :
        1095             :
        1096             :
        1097             :
        1098             :     ! ------------------------------------------------------- !
        1099             :     ! Initialize output variables defined for all grid points !
        1100             :     ! ------------------------------------------------------- !
        1101             :
        1102           0 :     umf_out(:iend,0:mkx)         = 0.0_r8
        1103           0 :     slflx_out(:iend,0:mkx)       = 0.0_r8
        1104           0 :     qtflx_out(:iend,0:mkx)       = 0.0_r8
        1105           0 :     flxprc1_out(:iend,0:mkx)     = 0.0_r8
        1106           0 :     flxsnow1_out(:iend,0:mkx)    = 0.0_r8
        1107           0 :     qvten_out(:iend,:mkx)        = 0.0_r8
        1108           0 :     qlten_out(:iend,:mkx)        = 0.0_r8
        1109           0 :     qiten_out(:iend,:mkx)        = 0.0_r8
        1110           0 :     sten_out(:iend,:mkx)         = 0.0_r8
        1111           0 :     uten_out(:iend,:mkx)         = 0.0_r8
        1112           0 :     vten_out(:iend,:mkx)         = 0.0_r8
        1113           0 :     qrten_out(:iend,:mkx)        = 0.0_r8
        1114           0 :     qsten_out(:iend,:mkx)        = 0.0_r8
        1115           0 :     precip_out(:iend)            = 0.0_r8
        1116           0 :     snow_out(:iend)              = 0.0_r8
        1117           0 :     evapc_out(:iend,:mkx)        = 0.0_r8
        1118           0 :     cufrc_out(:iend,:mkx)        = 0.0_r8
        1119           0 :     qcu_out(:iend,:mkx)          = 0.0_r8
        1120           0 :     qlu_out(:iend,:mkx)          = 0.0_r8
        1121           0 :     qiu_out(:iend,:mkx)          = 0.0_r8
        1122           0 :     fer_out(:iend,:mkx)          = 0.0_r8
        1123           0 :     fdr_out(:iend,:mkx)          = 0.0_r8
        1124           0 :     cinh_out(:iend)              = -1.0_r8
        1125           0 :     cinlclh_out(:iend)           = -1.0_r8
        1126           0 :     cbmf_out(:iend)              = 0.0_r8
        1127           0 :     qc_out(:iend,:mkx)           = 0.0_r8
        1128           0 :     rliq_out(:iend)              = 0.0_r8
        1129           0 :     cnt_out(:iend)               = real(mkx, r8)
        1130           0 :     cnb_out(:iend)               = 0.0_r8
        1131           0 :     qtten_out(:iend,:mkx)        = 0.0_r8
        1132           0 :     slten_out(:iend,:mkx)        = 0.0_r8
        1133           0 :     ufrc_out(:iend,0:mkx)        = 0.0_r8
        1134             :
        1135           0 :     uflx_out(:iend,0:mkx)        = 0.0_r8
        1136           0 :     vflx_out(:iend,0:mkx)        = 0.0_r8
        1137             :
        1138           0 :     trten_out(:iend,:mkx,:ncnst) = 0.0_r8
        1139           0 :     trflx_out(:iend,0:mkx,:ncnst)= 0.0_r8
        1140             :
        1141           0 :     ufrcinvbase_out(:iend)       = 0.0_r8
        1142           0 :     ufrclcl_out(:iend)           = 0.0_r8
        1143           0 :     winvbase_out(:iend)          = 0.0_r8
        1144           0 :     wlcl_out(:iend)              = 0.0_r8
        1145           0 :     plcl_out(:iend)              = 0.0_r8
        1146           0 :     pinv_out(:iend)              = 0.0_r8
        1147           0 :     plfc_out(:iend)              = 0.0_r8
        1148           0 :     pbup_out(:iend)              = 0.0_r8
        1149           0 :     ppen_out(:iend)              = 0.0_r8
        1150           0 :     qtsrc_out(:iend)             = 0.0_r8
        1151           0 :     thlsrc_out(:iend)            = 0.0_r8
        1152           0 :     thvlsrc_out(:iend)           = 0.0_r8
        1153           0 :     emfkbup_out(:iend)           = 0.0_r8
        1154           0 :     cbmflimit_out(:iend)         = 0.0_r8
        1155           0 :     tkeavg_out(:iend)            = 0.0_r8
        1156           0 :     zinv_out(:iend)              = 0.0_r8
        1157           0 :     rcwp_out(:iend)              = 0.0_r8
        1158           0 :     rlwp_out(:iend)              = 0.0_r8
        1159           0 :     riwp_out(:iend)              = 0.0_r8
        1160             :
        1161           0 :     wu_out(:iend,0:mkx)          = 0.0_r8
        1162           0 :     qtu_out(:iend,0:mkx)         = 0.0_r8
        1163           0 :     thlu_out(:iend,0:mkx)        = 0.0_r8
        1164           0 :     thvu_out(:iend,0:mkx)        = 0.0_r8
        1165           0 :     uu_out(:iend,0:mkx)          = 0.0_r8
        1166           0 :     vu_out(:iend,0:mkx)          = 0.0_r8
        1167           0 :     qtu_emf_out(:iend,0:mkx)     = 0.0_r8
        1168           0 :     thlu_emf_out(:iend,0:mkx)    = 0.0_r8
        1169           0 :     uu_emf_out(:iend,0:mkx)      = 0.0_r8
        1170           0 :     vu_emf_out(:iend,0:mkx)      = 0.0_r8
        1171           0 :     uemf_out(:iend,0:mkx)        = 0.0_r8
        1172             :
        1173           0 :     tru_out(:iend,0:mkx,:ncnst)     = 0.0_r8
        1174           0 :     tru_emf_out(:iend,0:mkx,:ncnst) = 0.0_r8
        1175             :
        1176           0 :     dwten_out(:iend,:mkx)        = 0.0_r8
        1177           0 :     diten_out(:iend,:mkx)        = 0.0_r8
        1178           0 :     flxrain_out(:iend,0:mkx)     = 0.0_r8
        1179           0 :     flxsnow_out(:iend,0:mkx)     = 0.0_r8
        1180           0 :     ntraprd_out(:iend,mkx)       = 0.0_r8
        1181           0 :     ntsnprd_out(:iend,mkx)       = 0.0_r8
        1182             :
        1183           0 :     excessu_arr_out(:iend,:mkx)  = 0.0_r8
        1184           0 :     excess0_arr_out(:iend,:mkx)  = 0.0_r8
        1185           0 :     xc_arr_out(:iend,:mkx)       = 0.0_r8
        1186           0 :     aquad_arr_out(:iend,:mkx)    = 0.0_r8
        1187           0 :     bquad_arr_out(:iend,:mkx)    = 0.0_r8
        1188           0 :     cquad_arr_out(:iend,:mkx)    = 0.0_r8
        1189           0 :     bogbot_arr_out(:iend,:mkx)   = 0.0_r8
        1190           0 :     bogtop_arr_out(:iend,:mkx)   = 0.0_r8
        1191             :
        1192           0 :     exit_UWCu(:iend)             = 0.0_r8
        1193           0 :     exit_conden(:iend)           = 0.0_r8
        1194           0 :     exit_klclmkx(:iend)          = 0.0_r8
        1195           0 :     exit_klfcmkx(:iend)          = 0.0_r8
        1196           0 :     exit_ufrc(:iend)             = 0.0_r8
        1197           0 :     exit_wtw(:iend)              = 0.0_r8
        1198           0 :     exit_drycore(:iend)          = 0.0_r8
        1199           0 :     exit_wu(:iend)               = 0.0_r8
        1200           0 :     exit_cufilter(:iend)         = 0.0_r8
        1201           0 :     exit_kinv1(:iend)            = 0.0_r8
        1202           0 :     exit_rei(:iend)              = 0.0_r8
        1203             :
        1204           0 :     limit_shcu(:iend)            = 0.0_r8
        1205           0 :     limit_negcon(:iend)          = 0.0_r8
        1206           0 :     limit_ufrc(:iend)            = 0.0_r8
        1207           0 :     limit_ppen(:iend)            = 0.0_r8
        1208           0 :     limit_emf(:iend)             = 0.0_r8
        1209           0 :     limit_cinlcl(:iend)          = 0.0_r8
        1210           0 :     limit_cin(:iend)             = 0.0_r8
        1211           0 :     limit_cbmf(:iend)            = 0.0_r8
        1212           0 :     limit_rei(:iend)             = 0.0_r8
        1213             :
        1214           0 :     ind_delcin(:iend)            = 0.0_r8
        1215             :
        1216             :     !--------------------------------------------------------------!
        1217             :     !                                                              !
        1218             :     ! Start the column i loop where i is a horizontal column index !
        1219             :     !                                                              !
        1220             :     !--------------------------------------------------------------!
        1221             :
        1222             :     ! Compute wet-bulb temperature and specific humidity
        1223             :     ! for treating evaporation of precipitation.
        1224             :
        1225             :     ! "True" means ice will be taken into account
        1226           0 :     do k = 1, mkx
        1227             :        call findsp_vc(qv0_in(:iend,k), t0_in(:iend,k), p0_in(:iend,k), .true., &
        1228           0 :             tw0_in(:iend,k), qw0_in(:iend,k))
        1229             :     end do
        1230             :
        1231           0 :     do i = 1, iend
        1232             :
        1233           0 :       id_exit = .false.
        1234             :
        1235             :       ! -------------------------------------------- !
        1236             :       ! Define 1D input variables at each grid point !
        1237             :       ! -------------------------------------------- !
        1238             :
        1239           0 :       ps0(0:mkx)       = ps0_in(i,0:mkx)
        1240           0 :       zs0(0:mkx)       = zs0_in(i,0:mkx)
        1241           0 :       p0(:mkx)         = p0_in(i,:mkx)
        1242           0 :       z0(:mkx)         = z0_in(i,:mkx)
        1243           0 :       dp0(:mkx)        = dp0_in(i,:mkx)
        1244           0 :       dpdry0(:mkx)     = dpdry0_in(i,:mkx)
        1245           0 :       u0(:mkx)         = u0_in(i,:mkx)
        1246           0 :       v0(:mkx)         = v0_in(i,:mkx)
        1247           0 :       qv0(:mkx)        = qv0_in(i,:mkx)
        1248           0 :       ql0(:mkx)        = ql0_in(i,:mkx)
        1249           0 :       qi0(:mkx)        = qi0_in(i,:mkx)
        1250           0 :       t0(:mkx)         = t0_in(i,:mkx)
        1251           0 :       s0(:mkx)         = s0_in(i,:mkx)
        1252           0 :       tke(0:mkx)       = tke_in(i,0:mkx)
        1253           0 :       cldfrct(:mkx)    = cldfrct_in(i,:mkx)
        1254           0 :       concldfrct(:mkx) = concldfrct_in(i,:mkx)
        1255           0 :       pblh             = pblh_in(i)
        1256           0 :       cush             = cush_inout(i)
        1257           0 :       do m = 1, ncnst
        1258           0 :          tr0(:mkx,m)   = tr0_in(i,:mkx,m)
        1259             :       enddo
        1260             :
        1261             :       ! --------------------------------------------------------- !
        1262             :       ! Compute other basic thermodynamic variables directly from !
        1263             :       ! the input variables at each grid point                    !
        1264             :       ! --------------------------------------------------------- !
        1265             :
        1266             :       !----- 1. Compute internal environmental variables
        1267             :
        1268           0 :       exn0(:mkx)   = (p0(:mkx)/p00)**rovcp
        1269           0 :       exns0(0:mkx) = (ps0(0:mkx)/p00)**rovcp
        1270           0 :       qt0(:mkx)    = (qv0(:mkx) + ql0(:mkx) + qi0(:mkx))
        1271           0 :       thl0(:mkx)   = (t0(:mkx) - xlv*ql0(:mkx)/cp - xls*qi0(:mkx)/cp)/exn0(:mkx)
        1272           0 :       thvl0(:mkx)  = (1._r8 + zvir*qt0(:mkx))*thl0(:mkx)
        1273             :
        1274             :       !----- 2. Compute slopes of environmental variables in each layer
        1275             :       !         Dimension of ssthl0(:mkx) is implicit.
        1276             :
        1277           0 :       ssthl0       = slope(mkx,thl0,p0)
        1278           0 :       ssqt0        = slope(mkx,qt0 ,p0)
        1279           0 :       ssu0         = slope(mkx,u0  ,p0)
        1280           0 :       ssv0         = slope(mkx,v0  ,p0)
        1281           0 :       do m = 1, ncnst
        1282           0 :          sstr0(:mkx,m) = slope(mkx,tr0(:mkx,m),p0)
        1283             :       enddo
        1284             :
        1285             :       !----- 3. Compute "thv0" and "thvl0" at the top/bottom interfaces in each layer
        1286             :       !         There are computed from the reconstructed thl, qt at the top/bottom.
        1287             :
        1288           0 :       do k = 1, mkx
        1289             :
        1290           0 :          thl0bot = thl0(k) + ssthl0(k)*(ps0(k-1) - p0(k))
        1291           0 :          qt0bot  = qt0(k)  + ssqt0(k) *(ps0(k-1) - p0(k))
        1292           0 :          call conden(ps0(k-1),thl0bot,qt0bot,thj,qvj,qlj,qij,qse,id_check)
        1293           0 :          if( id_check .eq. 1 ) then
        1294           0 :              exit_conden(i) = 1._r8
        1295           0 :              id_exit = .true.
        1296           0 :              go to 333
        1297             :          end if
        1298           0 :          thv0bot(k)  = thj*(1._r8 + zvir*qvj - qlj - qij)
        1299           0 :          thvl0bot(k) = thl0bot*(1._r8 + zvir*qt0bot)
        1300             :
        1301           0 :          thl0top = thl0(k) + ssthl0(k)*(ps0(k) - p0(k))
        1302           0 :          qt0top  =  qt0(k) + ssqt0(k) *(ps0(k) - p0(k))
        1303           0 :          call conden(ps0(k),thl0top,qt0top,thj,qvj,qlj,qij,qse,id_check)
        1304           0 :          if( id_check .eq. 1 ) then
        1305           0 :              exit_conden(i) = 1._r8
        1306           0 :              id_exit = .true.
        1307           0 :              go to 333
        1308             :          end if
        1309           0 :          thv0top(k)  = thj*(1._r8 + zvir*qvj - qlj - qij)
        1310           0 :          thvl0top(k) = thl0top*(1._r8 + zvir*qt0top)
        1311             :
        1312             :       end do
        1313             :
        1314             :       ! ------------------------------------------------------------ !
        1315             :       ! Save input and related environmental thermodynamic variables !
        1316             :       ! for use at "iter_cin=2" when "del_CIN >= 0"                  !
        1317             :       ! ------------------------------------------------------------ !
        1318             :
        1319           0 :       qv0_o(:mkx)          = qv0(:mkx)
        1320           0 :       ql0_o(:mkx)          = ql0(:mkx)
        1321           0 :       qi0_o(:mkx)          = qi0(:mkx)
        1322           0 :       t0_o(:mkx)           = t0(:mkx)
        1323           0 :       s0_o(:mkx)           = s0(:mkx)
        1324           0 :       u0_o(:mkx)           = u0(:mkx)
        1325           0 :       v0_o(:mkx)           = v0(:mkx)
        1326           0 :       qt0_o(:mkx)          = qt0(:mkx)
        1327           0 :       thl0_o(:mkx)         = thl0(:mkx)
        1328           0 :       thvl0_o(:mkx)        = thvl0(:mkx)
        1329           0 :       ssthl0_o(:mkx)       = ssthl0(:mkx)
        1330           0 :       ssqt0_o(:mkx)        = ssqt0(:mkx)
        1331           0 :       thv0bot_o(:mkx)      = thv0bot(:mkx)
        1332           0 :       thv0top_o(:mkx)      = thv0top(:mkx)
        1333           0 :       thvl0bot_o(:mkx)     = thvl0bot(:mkx)
        1334           0 :       thvl0top_o(:mkx)     = thvl0top(:mkx)
        1335           0 :       ssu0_o(:mkx)         = ssu0(:mkx)
        1336           0 :       ssv0_o(:mkx)         = ssv0(:mkx)
        1337           0 :       do m = 1, ncnst
        1338           0 :          tr0_o(:mkx,m)     = tr0(:mkx,m)
        1339           0 :          sstr0_o(:mkx,m)   = sstr0(:mkx,m)
        1340             :       enddo
        1341             :
        1342             :       ! ---------------------------------------------- !
        1343             :       ! Initialize output variables at each grid point !
        1344             :       ! ---------------------------------------------- !
        1345             :
        1346           0 :       umf(0:mkx)          = 0.0_r8
        1347           0 :       emf(0:mkx)          = 0.0_r8
        1348           0 :       slflx(0:mkx)        = 0.0_r8
        1349           0 :       qtflx(0:mkx)        = 0.0_r8
        1350           0 :       uflx(0:mkx)         = 0.0_r8
        1351           0 :       vflx(0:mkx)         = 0.0_r8
        1352           0 :       qvten(:mkx)         = 0.0_r8
        1353           0 :       qlten(:mkx)         = 0.0_r8
        1354           0 :       qiten(:mkx)         = 0.0_r8
        1355           0 :       sten(:mkx)          = 0.0_r8
        1356           0 :       uten(:mkx)          = 0.0_r8
        1357           0 :       vten(:mkx)          = 0.0_r8
        1358           0 :       qrten(:mkx)         = 0.0_r8
        1359           0 :       qsten(:mkx)         = 0.0_r8
        1360           0 :       dwten(:mkx)         = 0.0_r8
        1361           0 :       diten(:mkx)         = 0.0_r8
        1362           0 :       precip              = 0.0_r8
        1363           0 :       snow                = 0.0_r8
        1364           0 :       evapc(:mkx)         = 0.0_r8
        1365           0 :       cufrc(:mkx)         = 0.0_r8
        1366           0 :       qcu(:mkx)           = 0.0_r8
        1367           0 :       qlu(:mkx)           = 0.0_r8
        1368           0 :       qiu(:mkx)           = 0.0_r8
        1369           0 :       fer(:mkx)           = 0.0_r8
        1370           0 :       fdr(:mkx)           = 0.0_r8
        1371           0 :       cin                 = 0.0_r8
        1372           0 :       cbmf                = 0.0_r8
        1373           0 :       qc(:mkx)            = 0.0_r8
        1374           0 :       qc_l(:mkx)          = 0.0_r8
        1375           0 :       qc_i(:mkx)          = 0.0_r8
        1376           0 :       rliq                = 0.0_r8
        1377           0 :       cnt                 = real(mkx, r8)
        1378           0 :       cnb                 = 0.0_r8
        1379           0 :       qtten(:mkx)         = 0.0_r8
        1380           0 :       slten(:mkx)         = 0.0_r8
        1381           0 :       ufrc(0:mkx)         = 0.0_r8
        1382             :
        1383           0 :       thlu(0:mkx)         = 0.0_r8
        1384           0 :       qtu(0:mkx)          = 0.0_r8
        1385           0 :       uu(0:mkx)           = 0.0_r8
        1386           0 :       vu(0:mkx)           = 0.0_r8
        1387           0 :       wu(0:mkx)           = 0.0_r8
        1388           0 :       thvu(0:mkx)         = 0.0_r8
        1389           0 :       thlu_emf(0:mkx)     = 0.0_r8
        1390           0 :       qtu_emf(0:mkx)      = 0.0_r8
        1391           0 :       uu_emf(0:mkx)       = 0.0_r8
        1392           0 :       vu_emf(0:mkx)       = 0.0_r8
        1393             :
        1394           0 :       ufrcinvbase         = 0.0_r8
        1395           0 :       ufrclcl             = 0.0_r8
        1396           0 :       winvbase            = 0.0_r8
        1397           0 :       wlcl                = 0.0_r8
        1398             :       emfkbup             = 0.0_r8
        1399           0 :       cbmflimit           = 0.0_r8
        1400           0 :       excessu_arr(:mkx)   = 0.0_r8
        1401           0 :       excess0_arr(:mkx)   = 0.0_r8
        1402           0 :       xc_arr(:mkx)        = 0.0_r8
        1403           0 :       aquad_arr(:mkx)     = 0.0_r8
        1404           0 :       bquad_arr(:mkx)     = 0.0_r8
        1405           0 :       cquad_arr(:mkx)     = 0.0_r8
        1406           0 :       bogbot_arr(:mkx)    = 0.0_r8
        1407           0 :       bogtop_arr(:mkx)    = 0.0_r8
        1408             :
        1409           0 :       uemf(0:mkx)         = 0.0_r8
        1410           0 :       comsub(:mkx)        = 0.0_r8
        1411           0 :       qlten_sink(:mkx)    = 0.0_r8
        1412           0 :       qiten_sink(:mkx)    = 0.0_r8
        1413           0 :       nlten_sink(:mkx)    = 0.0_r8
        1414           0 :       niten_sink(:mkx)    = 0.0_r8
        1415             :
        1416           0 :       do m = 1, ncnst
        1417           0 :          trflx(0:mkx,m)   = 0.0_r8
        1418           0 :          trten(:mkx,m)    = 0.0_r8
        1419           0 :          tru(0:mkx,m)     = 0.0_r8
        1420           0 :          tru_emf(0:mkx,m) = 0.0_r8
        1421             :       enddo
        1422             :
        1423             :     !-----------------------------------------------!
        1424             :     ! Below 'iter' loop is for implicit CIN closure !
        1425             :     !-----------------------------------------------!
        1426             :
        1427             :     ! ----------------------------------------------------------------------------- !
        1428             :     ! It is important to note that this iterative cin loop is located at the outest !
        1429             :     ! shell of the code. Thus, source air properties can also be changed during the !
        1430             :     ! iterative cin calculation, because cumulus convection induces non-zero fluxes !
        1431             :     ! even at interfaces below PBL top height through 'fluxbelowinv' subroutine.    !
        1432             :     ! ----------------------------------------------------------------------------- !
        1433             :
        1434           0 :     do iter = 1, iter_cin
        1435             :
        1436             :        ! ---------------------------------------------------------------------- !
        1437             :        ! Cumulus scale height                                                   !
        1438             :        ! In contrast to the premitive code, cumulus scale height is iteratively !
        1439             :        ! calculated at each time step, and at each iterative cin step.          !
        1440             :        ! It is not clear whether I should locate below two lines within or  out !
        1441             :        ! of the iterative cin loop.                                             !
        1442             :        ! ---------------------------------------------------------------------- !
        1443             :
        1444           0 :        tscaleh = cush
        1445           0 :        cush    = -1._r8
        1446             :
        1447             :        ! ----------------------------------------------------------------------- !
        1448             :        ! Find PBL top height interface index, 'kinv-1' where 'kinv' is the layer !
        1449             :        ! index with PBLH in it. When PBLH is exactly at interface, 'kinv' is the !
        1450             :        ! layer index having PBLH as a lower interface.                           !
        1451             :        ! In the previous code, I set the lower limit of 'kinv' by 2  in order to !
        1452             :        ! be consistent with the other parts of the code. However in the modified !
        1453             :        ! code, I allowed 'kinv' to be 1 & if 'kinv = 1', I just exit the program !
        1454             :        ! without performing cumulus convection. This new approach seems to be    !
        1455             :        ! more reasonable: if PBL height is within 'kinv=1' layer, surface is STL !
        1456             :        ! interface (bflxs <= 0) and interface just above the surface should be   !
        1457             :        ! either non-turbulent (Ri>0.19) or stably turbulent (0<=Ri<0.19 but this !
        1458             :        ! interface is identified as a base external interface of upperlying CL.  !
        1459             :        ! Thus, when 'kinv=1', PBL scheme guarantees 'bflxs <= 0'.  For this case !
        1460             :        ! it is reasonable to assume that cumulus convection does not happen.     !
        1461             :        ! When these is SBCL, PBL height from the PBL scheme is likely to be very !
        1462             :        ! close at 'kinv-1' interface, but not exactly, since 'zi' information is !
        1463             :        ! changed between two model time steps. In order to ensure correct identi !
        1464             :        ! fication of 'kinv' for general case including SBCL, I imposed an offset !
        1465             :        ! of 5 [m] in the below 'kinv' finding block.                             !
        1466             :        ! ----------------------------------------------------------------------- !
        1467             :
        1468           0 :        do k = mkx - 1, 1, -1
        1469           0 :           if( (pblh + 5._r8 - zs0(k))*(pblh + 5._r8 - zs0(k+1)) .lt. 0._r8 ) then
        1470           0 :                kinv = k + 1
        1471           0 :                go to 15
        1472             :           endif
        1473             :        end do
        1474           0 :        kinv = 1
        1475             : 15     continue
        1476             :
        1477           0 :        if( kinv .le. 1 ) then
        1478           0 :            exit_kinv1(i) = 1._r8
        1479           0 :            id_exit = .true.
        1480           0 :            go to 333
        1481             :        endif
        1482             :        ! From here, it must be 'kinv >= 2'.
        1483             :
        1484             :        ! -------------------------------------------------------------------------- !
        1485             :        ! Find PBL averaged tke ('tkeavg') and minimum 'thvl' ('thvlmin') in the PBL !
        1486             :        ! In the current code, 'tkeavg' is obtained by averaging all interfacial TKE !
        1487             :        ! within the PBL. However, in order to be conceptually consistent with   PBL !
        1488             :        ! scheme, 'tkeavg' should be calculated by considering surface buoyancy flux.!
        1489             :        ! If surface buoyancy flux is positive ( bflxs >0 ), surface interfacial TKE !
        1490             :        ! should be included in calculating 'tkeavg', while if bflxs <= 0,   surface !
        1491             :        ! interfacial TKE should not be included in calculating 'tkeavg'.   I should !
        1492             :        ! modify the code when 'bflxs' is available as an input of cumulus scheme.   !
        1493             :        ! 'thvlmin' is a minimum 'thvl' within PBL obtained by comparing top &  base !
        1494             :        ! interface values of 'thvl' in each layers within the PBL.                  !
        1495             :        ! -------------------------------------------------------------------------- !
        1496             :
        1497             :        dpsum    = 0._r8
        1498             :        tkeavg   = 0._r8
        1499             :        thvlmin  = 1000._r8
        1500           0 :        do k = 0, kinv - 1   ! Here, 'k' is an interfacial layer index.
        1501           0 :           if( k .eq. 0 ) then
        1502           0 :               dpi = ps0(0) - p0(1)
        1503           0 :           elseif( k .eq. (kinv-1) ) then
        1504           0 :               dpi = p0(kinv-1) - ps0(kinv-1)
        1505             :           else
        1506           0 :               dpi = p0(k) - p0(k+1)
        1507             :           endif
        1508           0 :           dpsum  = dpsum  + dpi
        1509           0 :           tkeavg = tkeavg + dpi*tke(k)
        1510           0 :           if( k .ne. 0 ) thvlmin = min(thvlmin,min(thvl0bot(k),thvl0top(k)))
        1511             :        end do
        1512           0 :        tkeavg  = tkeavg/dpsum
        1513             :
        1514             :        ! ------------------------------------------------------------------ !
        1515             :        ! Find characteristics of cumulus source air: qtsrc,thlsrc,usrc,vsrc !
        1516             :        ! Note that 'thlsrc' was con-cocked using 'thvlsrc' and 'qtsrc'.     !
        1517             :        ! 'qtsrc' is defined as the lowest layer mid-point value;   'thlsrc' !
        1518             :        ! is from 'qtsrc' and 'thvlmin=thvlsrc'; 'usrc' & 'vsrc' are defined !
        1519             :        ! as the values just below the PBL top interface.                    !
        1520             :        ! ------------------------------------------------------------------ !
        1521             :
        1522           0 :        qtsrc   = qt0(1)
        1523           0 :        thvlsrc = thvlmin
        1524           0 :        thlsrc  = thvlsrc / ( 1._r8 + zvir * qtsrc )
        1525           0 :        usrc    = u0(kinv-1) + ssu0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        1526           0 :        vsrc    = v0(kinv-1) + ssv0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        1527           0 :        do m = 1, ncnst
        1528           0 :           trsrc(m) = tr0(1,m)
        1529             :        enddo
        1530             :
        1531             :        ! ------------------------------------------------------------------ !
        1532             :        ! Find LCL of the source air and a layer index containing LCL (klcl) !
        1533             :        ! When the LCL is exactly at the interface, 'klcl' is a layer index  !
        1534             :        ! having 'plcl' as the lower interface similar to the 'kinv' case.   !
        1535             :        ! In the previous code, I assumed that if LCL is located within the  !
        1536             :        ! lowest model layer ( 1 ) or the top model layer ( mkx ), then  no  !
        1537             :        ! convective adjustment is performed and just exited.   However, in  !
        1538             :        ! the revised code, I relaxed the first constraint and  even though  !
        1539             :        ! LCL is at the lowest model layer, I allowed cumulus convection to  !
        1540             :        ! be initiated. For this case, cumulus convection should be started  !
        1541             :        ! from the PBL top height, as shown in the following code.           !
        1542             :        ! When source air is already saturated even at the surface, klcl is  !
        1543             :        ! set to 1.                                                          !
        1544             :        ! ------------------------------------------------------------------ !
        1545             :
        1546           0 :        plcl = qsinvert(qtsrc,thlsrc,ps0(0))
        1547           0 :        do k = 0, mkx
        1548           0 :           if( ps0(k) .lt. plcl ) then
        1549             :               klcl = k
        1550             :               go to 25
        1551             :           endif
        1552             :        end do
        1553             :        klcl = mkx
        1554             : 25     continue
        1555           0 :        klcl = max(1,klcl)
        1556             :
        1557           0 :        if( plcl .lt. 30000._r8 ) then
        1558             :      ! if( klcl .eq. mkx ) then
        1559           0 :            exit_klclmkx(i) = 1._r8
        1560           0 :            id_exit = .true.
        1561           0 :            go to 333
        1562             :        endif
        1563             :
        1564             :        ! ------------------------------------------------------------- !
        1565             :        ! Calculate environmental virtual potential temperature at LCL, !
        1566             :        !'thv0lcl' which is solely used in the 'cin' calculation. Note  !
        1567             :        ! that 'thv0lcl' is calculated first by calculating  'thl0lcl'  !
        1568             :        ! and 'qt0lcl' at the LCL, and performing 'conden' afterward,   !
        1569             :        ! in fully consistent with the other parts of the code.         !
        1570             :        ! ------------------------------------------------------------- !
        1571             :
        1572           0 :        thl0lcl = thl0(klcl) + ssthl0(klcl) * ( plcl - p0(klcl) )
        1573           0 :        qt0lcl  = qt0(klcl)  + ssqt0(klcl)  * ( plcl - p0(klcl) )
        1574           0 :        call conden(plcl,thl0lcl,qt0lcl,thj,qvj,qlj,qij,qse,id_check)
        1575           0 :        if( id_check .eq. 1 ) then
        1576           0 :            exit_conden(i) = 1._r8
        1577           0 :            id_exit = .true.
        1578           0 :            go to 333
        1579             :        end if
        1580           0 :        thv0lcl = thj * ( 1._r8 + zvir * qvj - qlj - qij )
        1581             :
        1582             :        ! ------------------------------------------------------------------------ !
        1583             :        ! Compute Convective Inhibition, 'cin' & 'cinlcl' [J/kg]=[m2/s2] TKE unit. !
        1584             :        !                                                                          !
        1585             :        ! 'cin' (cinlcl) is computed from the PBL top interface to LFC (LCL) using !
        1586             :        ! piecewisely reconstructed environmental profiles, assuming environmental !
        1587             :        ! buoyancy profile within each layer ( or from LCL to upper interface in   !
        1588             :        ! each layer ) is simply a linear profile. For the purpose of cin (cinlcl) !
        1589             :        ! calculation, we simply assume that lateral entrainment does not occur in !
        1590             :        ! updrafting cumulus plume, i.e., cumulus source air property is conserved.!
        1591             :        ! Below explains some rules used in the calculations of cin (cinlcl).   In !
        1592             :        ! general, both 'cin' and 'cinlcl' are calculated from a PBL top interface !
        1593             :        ! to LCL and LFC, respectively :                                           !
        1594             :        ! 1. If LCL is lower than the PBL height, cinlcl = 0 and cin is calculated !
        1595             :        !    from PBL height to LFC.                                               !
        1596             :        ! 2. If LCL is higher than PBL height,   'cinlcl' is calculated by summing !
        1597             :        !    both positive and negative cloud buoyancy up to LCL using 'single_cin'!
        1598             :        !    From the LCL to LFC, however, only negative cloud buoyancy is counted !
        1599             :        !    to calculate final 'cin' upto LFC.                                    !
        1600             :        ! 3. If either 'cin' or 'cinlcl' is negative, they are set to be zero.     !
        1601             :        ! In the below code, 'klfc' is the layer index containing 'LFC' similar to !
        1602             :        ! 'kinv' and 'klcl'.                                                       !
        1603             :        ! ------------------------------------------------------------------------ !
        1604             :
        1605           0 :         cin    = 0._r8
        1606           0 :         cinlcl = 0._r8
        1607           0 :         plfc   = 0._r8
        1608           0 :         klfc   = mkx
        1609             :
        1610             :         ! ------------------------------------------------------------------------- !
        1611             :         ! Case 1. LCL height is higher than PBL interface ( 'pLCL <= ps0(kinv-1)' ) !
        1612             :         ! ------------------------------------------------------------------------- !
        1613             :
        1614           0 :         if( klcl .ge. kinv ) then
        1615             :
        1616           0 :             do k = kinv, mkx - 1
        1617           0 :                if( k .lt. klcl ) then
        1618           0 :                    thvubot = thvlsrc
        1619           0 :                    thvutop = thvlsrc
        1620           0 :                    cin     = cin + single_cin(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop)
        1621           0 :                elseif( k .eq. klcl ) then
        1622             :                    !----- Bottom to LCL
        1623           0 :                    thvubot = thvlsrc
        1624           0 :                    thvutop = thvlsrc
        1625           0 :                    cin     = cin + single_cin(ps0(k-1),thv0bot(k),plcl,thv0lcl,thvubot,thvutop)
        1626           0 :                    if( cin .lt. 0._r8 ) limit_cinlcl(i) = 1._r8
        1627           0 :                    cinlcl  = max(cin,0._r8)
        1628           0 :                    cin     = cinlcl
        1629             :                    !----- LCL to Top
        1630           0 :                    thvubot = thvlsrc
        1631           0 :                    call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check)
        1632           0 :                    if( id_check .eq. 1 ) then
        1633           0 :                        exit_conden(i) = 1._r8
        1634           0 :                        id_exit = .true.
        1635           0 :                        go to 333
        1636             :                    end if
        1637           0 :                    thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        1638             :                    call getbuoy(plcl,thv0lcl,ps0(k),thv0top(k),thvubot,thvutop,plfc,cin)
        1639           0 :                    if( plfc .gt. 0._r8 ) then
        1640             :                        klfc = k
        1641             :                        go to 35
        1642             :                    end if
        1643             :                else
        1644           0 :                    thvubot = thvutop
        1645           0 :                    call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check)
        1646           0 :                    if( id_check .eq. 1 ) then
        1647           0 :                        exit_conden(i) = 1._r8
        1648           0 :                        id_exit = .true.
        1649           0 :                        go to 333
        1650             :                    end if
        1651           0 :                    thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        1652           0 :                    call getbuoy(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop,plfc,cin)
        1653           0 :                    if( plfc .gt. 0._r8 ) then
        1654             :                        klfc = k
        1655             :                        go to 35
        1656             :                    end if
        1657             :                endif
        1658             :             end do
        1659             :
        1660             :        ! ----------------------------------------------------------------------- !
        1661             :        ! Case 2. LCL height is lower than PBL interface ( 'pLCL > ps0(kinv-1)' ) !
        1662             :        ! ----------------------------------------------------------------------- !
        1663             :
        1664             :        else
        1665           0 :           cinlcl = 0._r8
        1666           0 :           do k = kinv, mkx - 1
        1667           0 :              call conden(ps0(k-1),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check)
        1668           0 :              if( id_check .eq. 1 ) then
        1669           0 :                  exit_conden(i) = 1._r8
        1670           0 :                  id_exit = .true.
        1671           0 :                  go to 333
        1672             :              end if
        1673           0 :              thvubot = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        1674           0 :              call conden(ps0(k),thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check)
        1675           0 :              if( id_check .eq. 1 ) then
        1676           0 :                  exit_conden(i) = 1._r8
        1677           0 :                  id_exit = .true.
        1678           0 :                  go to 333
        1679             :              end if
        1680           0 :              thvutop = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        1681           0 :              call getbuoy(ps0(k-1),thv0bot(k),ps0(k),thv0top(k),thvubot,thvutop,plfc,cin)
        1682           0 :              if( plfc .gt. 0._r8 ) then
        1683             :                  klfc = k
        1684             :                  go to 35
        1685             :              end if
        1686             :           end do
        1687             :        endif  ! End of CIN case selection
        1688             :
        1689             :  35    continue
        1690           0 :        if( cin .lt. 0._r8 ) limit_cin(i) = 1._r8
        1691           0 :        cin = max(0._r8,cin)
        1692           0 :        if( klfc .ge. mkx ) then
        1693           0 :            klfc = mkx
        1694             :          ! write(iulog,*) 'klfc >= mkx'
        1695           0 :            exit_klfcmkx(i) = 1._r8
        1696           0 :            id_exit = .true.
        1697           0 :            go to 333
        1698             :        endif
        1699             :
        1700             :        ! ---------------------------------------------------------------------- !
        1701             :        ! In order to calculate implicit 'cin' (or 'cinlcl'), save the initially !
        1702             :        ! calculated 'cin' and 'cinlcl', and other related variables. These will !
        1703             :        ! be restored after calculating implicit CIN.                            !
        1704             :        ! ---------------------------------------------------------------------- !
        1705             :
        1706           0 :        if( iter .eq. 1 ) then
        1707           0 :            cin_i       = cin
        1708           0 :            cinlcl_i    = cinlcl
        1709           0 :            ke          = rbuoy / ( rkfre * tkeavg + epsvarw )
        1710           0 :            kinv_o      = kinv
        1711           0 :            klcl_o      = klcl
        1712           0 :            klfc_o      = klfc
        1713           0 :            plcl_o      = plcl
        1714           0 :            plfc_o      = plfc
        1715           0 :            tkeavg_o    = tkeavg
        1716           0 :            thvlmin_o   = thvlmin
        1717           0 :            qtsrc_o     = qtsrc
        1718           0 :            thvlsrc_o   = thvlsrc
        1719           0 :            thlsrc_o    = thlsrc
        1720           0 :            usrc_o      = usrc
        1721           0 :            vsrc_o      = vsrc
        1722           0 :            thv0lcl_o   = thv0lcl
        1723           0 :            do m = 1, ncnst
        1724           0 :               trsrc_o(m) = trsrc(m)
        1725             :            enddo
        1726             :        endif
        1727             :
        1728             :      ! Modification : If I impose w = max(0.1_r8, w) up to the top interface of
        1729             :      !                klfc, I should only use cinlfc.  That is, if I want to
        1730             :      !                use cinlcl, I should not impose w = max(0.1_r8, w).
        1731             :      !                Using cinlcl is equivalent to treating only 'saturated'
        1732             :      !                moist convection. Note that in this sense, I should keep
        1733             :      !                the functionality of both cinlfc and cinlcl.
        1734             :      !                However, the treatment of penetrative entrainment level becomes
        1735             :      !                ambiguous if I choose 'cinlcl'. Thus, the best option is to use
        1736             :      !                'cinlfc'.
        1737             :
        1738             :        ! -------------------------------------------------------------------------- !
        1739             :        ! Calculate implicit 'cin' by averaging initial and final cins.    Note that !
        1740             :        ! implicit CIN is adopted only when cumulus convection stabilized the system,!
        1741             :        ! i.e., only when 'del_CIN >0'. If 'del_CIN<=0', just use explicit CIN. Note !
        1742             :        ! also that since 'cinlcl' is set to zero whenever LCL is below the PBL top, !
        1743             :        ! (see above CIN calculation part), the use of 'implicit CIN=cinlcl'  is not !
        1744             :        ! good. Thus, when using implicit CIN, always try to only use 'implicit CIN= !
        1745             :        ! cin', not 'implicit CIN=cinlcl'. However, both 'CIN=cin' and 'CIN=cinlcl'  !
        1746             :        ! are good when using explicit CIN.                                          !
        1747             :        ! -------------------------------------------------------------------------- !
        1748             :
        1749           0 :        if( iter .ne. 1 ) then
        1750             :
        1751           0 :            cin_f = cin
        1752           0 :            cinlcl_f = cinlcl
        1753           0 :            if( use_CINcin ) then
        1754           0 :                del_CIN = cin_f - cin_i
        1755             :            else
        1756             :                del_CIN = cinlcl_f - cinlcl_i
        1757             :            endif
        1758             :
        1759           0 :            if( del_CIN .gt. 0._r8 ) then
        1760             :
        1761             :                ! -------------------------------------------------------------- !
        1762             :                ! Calculate implicit 'cin' and 'cinlcl'. Note that when we chose !
        1763             :                ! to use 'implicit CIN = cin', choose 'cinlcl = cinlcl_i' below: !
        1764             :                ! because iterative CIN only aims to obtain implicit CIN,  once  !
        1765             :                ! we obtained 'implicit CIN=cin', it is good to use the original !
        1766             :                ! profiles information for all the other variables after that.   !
        1767             :                ! Note 'cinlcl' will be explicitly used in calculating  'wlcl' & !
        1768             :                ! 'ufrclcl' after calculating 'winv' & 'ufrcinv'  at the PBL top !
        1769             :                ! interface later, after calculating 'cbmf'.                     !
        1770             :                ! -------------------------------------------------------------- !
        1771             :
        1772           0 :                alpha = compute_alpha( del_CIN, ke )
        1773           0 :                cin   = cin_i + alpha * del_CIN
        1774           0 :                if( use_CINcin ) then
        1775             :                    cinlcl = cinlcl_i
        1776             :                else
        1777             :                    cinlcl = cinlcl_i + alpha * del_cinlcl
        1778             :                endif
        1779             :
        1780             :                ! ----------------------------------------------------------------- !
        1781             :                ! Restore the original values from the previous 'iter_cin' step (1) !
        1782             :                ! to compute correct tendencies for (n+1) time step by implicit CIN !
        1783             :                ! ----------------------------------------------------------------- !
        1784             :
        1785           0 :                kinv      = kinv_o
        1786           0 :                klcl      = klcl_o
        1787           0 :                klfc      = klfc_o
        1788           0 :                plcl      = plcl_o
        1789           0 :                plfc      = plfc_o
        1790           0 :                tkeavg    = tkeavg_o
        1791           0 :                thvlmin   = thvlmin_o
        1792           0 :                qtsrc     = qtsrc_o
        1793           0 :                thvlsrc   = thvlsrc_o
        1794           0 :                thlsrc    = thlsrc_o
        1795           0 :                usrc      = usrc_o
        1796           0 :                vsrc      = vsrc_o
        1797           0 :                thv0lcl   = thv0lcl_o
        1798           0 :                do m = 1, ncnst
        1799           0 :                   trsrc(m) = trsrc_o(m)
        1800             :                enddo
        1801             :
        1802           0 :                qv0(:mkx)            = qv0_o(:mkx)
        1803           0 :                ql0(:mkx)            = ql0_o(:mkx)
        1804           0 :                qi0(:mkx)            = qi0_o(:mkx)
        1805           0 :                t0(:mkx)             = t0_o(:mkx)
        1806           0 :                s0(:mkx)             = s0_o(:mkx)
        1807           0 :                u0(:mkx)             = u0_o(:mkx)
        1808           0 :                v0(:mkx)             = v0_o(:mkx)
        1809           0 :                qt0(:mkx)            = qt0_o(:mkx)
        1810           0 :                thl0(:mkx)           = thl0_o(:mkx)
        1811           0 :                thvl0(:mkx)          = thvl0_o(:mkx)
        1812           0 :                ssthl0(:mkx)         = ssthl0_o(:mkx)
        1813           0 :                ssqt0(:mkx)          = ssqt0_o(:mkx)
        1814           0 :                thv0bot(:mkx)        = thv0bot_o(:mkx)
        1815           0 :                thv0top(:mkx)        = thv0top_o(:mkx)
        1816           0 :                thvl0bot(:mkx)       = thvl0bot_o(:mkx)
        1817           0 :                thvl0top(:mkx)       = thvl0top_o(:mkx)
        1818           0 :                ssu0(:mkx)           = ssu0_o(:mkx)
        1819           0 :                ssv0(:mkx)           = ssv0_o(:mkx)
        1820           0 :                do m = 1, ncnst
        1821           0 :                   tr0(:mkx,m)   = tr0_o(:mkx,m)
        1822           0 :                   sstr0(:mkx,m) = sstr0_o(:mkx,m)
        1823             :                enddo
        1824             :
        1825             :                ! ------------------------------------------------------ !
        1826             :                ! Initialize all fluxes, tendencies, and other variables !
        1827             :                ! in association with cumulus convection.                !
        1828             :                ! ------------------------------------------------------ !
        1829             :
        1830           0 :                umf(0:mkx)          = 0.0_r8
        1831           0 :                emf(0:mkx)          = 0.0_r8
        1832           0 :                slflx(0:mkx)        = 0.0_r8
        1833           0 :                qtflx(0:mkx)        = 0.0_r8
        1834           0 :                uflx(0:mkx)         = 0.0_r8
        1835           0 :                vflx(0:mkx)         = 0.0_r8
        1836           0 :                qvten(:mkx)         = 0.0_r8
        1837           0 :                qlten(:mkx)         = 0.0_r8
        1838           0 :                qiten(:mkx)         = 0.0_r8
        1839           0 :                sten(:mkx)          = 0.0_r8
        1840           0 :                uten(:mkx)          = 0.0_r8
        1841           0 :                vten(:mkx)          = 0.0_r8
        1842           0 :                qrten(:mkx)         = 0.0_r8
        1843           0 :                qsten(:mkx)         = 0.0_r8
        1844           0 :                dwten(:mkx)         = 0.0_r8
        1845           0 :                diten(:mkx)         = 0.0_r8
        1846           0 :                precip              = 0.0_r8
        1847           0 :                snow                = 0.0_r8
        1848           0 :                evapc(:mkx)         = 0.0_r8
        1849           0 :                cufrc(:mkx)         = 0.0_r8
        1850           0 :                qcu(:mkx)           = 0.0_r8
        1851           0 :                qlu(:mkx)           = 0.0_r8
        1852           0 :                qiu(:mkx)           = 0.0_r8
        1853           0 :                fer(:mkx)           = 0.0_r8
        1854           0 :                fdr(:mkx)           = 0.0_r8
        1855           0 :                qc(:mkx)            = 0.0_r8
        1856           0 :                qc_l(:mkx)          = 0.0_r8
        1857           0 :                qc_i(:mkx)          = 0.0_r8
        1858           0 :                rliq                = 0.0_r8
        1859           0 :                cbmf                = 0.0_r8
        1860           0 :                cnt                 = real(mkx, r8)
        1861           0 :                cnb                 = 0.0_r8
        1862           0 :                qtten(:mkx)         = 0.0_r8
        1863           0 :                slten(:mkx)         = 0.0_r8
        1864           0 :                ufrc(0:mkx)         = 0.0_r8
        1865             :
        1866           0 :                thlu(0:mkx)         = 0.0_r8
        1867           0 :                qtu(0:mkx)          = 0.0_r8
        1868           0 :                uu(0:mkx)           = 0.0_r8
        1869           0 :                vu(0:mkx)           = 0.0_r8
        1870           0 :                wu(0:mkx)           = 0.0_r8
        1871           0 :                thvu(0:mkx)         = 0.0_r8
        1872           0 :                thlu_emf(0:mkx)     = 0.0_r8
        1873           0 :                qtu_emf(0:mkx)      = 0.0_r8
        1874           0 :                uu_emf(0:mkx)       = 0.0_r8
        1875           0 :                vu_emf(0:mkx)       = 0.0_r8
        1876             :
        1877           0 :                do m = 1, ncnst
        1878           0 :                   trflx(0:mkx,m)   = 0.0_r8
        1879           0 :                   trten(:mkx,m)    = 0.0_r8
        1880           0 :                   tru(0:mkx,m)     = 0.0_r8
        1881           0 :                   tru_emf(0:mkx,m) = 0.0_r8
        1882             :                enddo
        1883             :
        1884             :                ! -------------------------------------------------- !
        1885             :                ! Below are diagnostic output variables for detailed !
        1886             :                ! analysis of cumulus scheme.                        !
        1887             :                ! -------------------------------------------------- !
        1888             :
        1889           0 :                ufrcinvbase         = 0.0_r8
        1890           0 :                ufrclcl             = 0.0_r8
        1891           0 :                winvbase            = 0.0_r8
        1892           0 :                wlcl                = 0.0_r8
        1893             :                emfkbup             = 0.0_r8
        1894           0 :                cbmflimit           = 0.0_r8
        1895           0 :                excessu_arr(:mkx)   = 0.0_r8
        1896           0 :                excess0_arr(:mkx)   = 0.0_r8
        1897           0 :                xc_arr(:mkx)        = 0.0_r8
        1898           0 :                aquad_arr(:mkx)     = 0.0_r8
        1899           0 :                bquad_arr(:mkx)     = 0.0_r8
        1900           0 :                cquad_arr(:mkx)     = 0.0_r8
        1901           0 :                bogbot_arr(:mkx)    = 0.0_r8
        1902           0 :                bogtop_arr(:mkx)    = 0.0_r8
        1903             :
        1904             :           else ! When 'del_CIN < 0', use explicit CIN instead of implicit CIN.
        1905             :
        1906             :                ! ----------------------------------------------------------- !
        1907             :                ! Identifier showing whether explicit or implicit CIN is used !
        1908             :                ! ----------------------------------------------------------- !
        1909             :
        1910           0 :                ind_delcin(i) = 1._r8
        1911             :
        1912             :                ! --------------------------------------------------------- !
        1913             :                ! Restore original output values of "iter_cin = 1" and exit !
        1914             :                ! --------------------------------------------------------- !
        1915             :
        1916           0 :                umf_out(i,0:mkx)         = umf_s(0:mkx)
        1917           0 :                qvten_out(i,:mkx)        = qvten_s(:mkx)
        1918           0 :                qlten_out(i,:mkx)        = qlten_s(:mkx)
        1919           0 :                qiten_out(i,:mkx)        = qiten_s(:mkx)
        1920           0 :                sten_out(i,:mkx)         = sten_s(:mkx)
        1921           0 :                uten_out(i,:mkx)         = uten_s(:mkx)
        1922           0 :                vten_out(i,:mkx)         = vten_s(:mkx)
        1923           0 :                qrten_out(i,:mkx)        = qrten_s(:mkx)
        1924           0 :                qsten_out(i,:mkx)        = qsten_s(:mkx)
        1925           0 :                precip_out(i)            = precip_s
        1926           0 :                snow_out(i)              = snow_s
        1927           0 :                evapc_out(i,:mkx)        = evapc_s(:mkx)
        1928           0 :                cush_inout(i)            = cush_s
        1929           0 :                cufrc_out(i,:mkx)        = cufrc_s(:mkx)
        1930           0 :                slflx_out(i,0:mkx)       = slflx_s(0:mkx)
        1931           0 :                qtflx_out(i,0:mkx)       = qtflx_s(0:mkx)
        1932           0 :                qcu_out(i,:mkx)          = qcu_s(:mkx)
        1933           0 :                qlu_out(i,:mkx)          = qlu_s(:mkx)
        1934           0 :                qiu_out(i,:mkx)          = qiu_s(:mkx)
        1935           0 :                cbmf_out(i)              = cbmf_s
        1936           0 :                qc_out(i,:mkx)           = qc_s(:mkx)
        1937           0 :                rliq_out(i)              = rliq_s
        1938           0 :                cnt_out(i)               = cnt_s
        1939           0 :                cnb_out(i)               = cnb_s
        1940           0 :                do m = 1, ncnst
        1941           0 :                   trten_out(i,:mkx,m)   = trten_s(:mkx,m)
        1942             :                enddo
        1943             :
        1944             :                ! ------------------------------------------------------------------------------ !
        1945             :                ! Below are diagnostic output variables for detailed analysis of cumulus scheme. !
        1946             :                ! The order of vertical index is reversed for this internal diagnostic output.   !
        1947             :                ! ------------------------------------------------------------------------------ !
        1948             :
        1949           0 :                fer_out(i,mkx:1:-1)      = fer_s(:mkx)
        1950           0 :                fdr_out(i,mkx:1:-1)      = fdr_s(:mkx)
        1951           0 :                cinh_out(i)              = cin_s
        1952           0 :                cinlclh_out(i)           = cinlcl_s
        1953           0 :                qtten_out(i,mkx:1:-1)    = qtten_s(:mkx)
        1954           0 :                slten_out(i,mkx:1:-1)    = slten_s(:mkx)
        1955           0 :                ufrc_out(i,mkx:0:-1)     = ufrc_s(0:mkx)
        1956           0 :                uflx_out(i,mkx:0:-1)     = uflx_s(0:mkx)
        1957           0 :                vflx_out(i,mkx:0:-1)     = vflx_s(0:mkx)
        1958             :
        1959           0 :                ufrcinvbase_out(i)       = ufrcinvbase_s
        1960           0 :                ufrclcl_out(i)           = ufrclcl_s
        1961           0 :                winvbase_out(i)          = winvbase_s
        1962           0 :                wlcl_out(i)              = wlcl_s
        1963           0 :                plcl_out(i)              = plcl_s
        1964           0 :                pinv_out(i)              = pinv_s
        1965           0 :                plfc_out(i)              = plfc_s
        1966           0 :                pbup_out(i)              = pbup_s
        1967           0 :                ppen_out(i)              = ppen_s
        1968           0 :                qtsrc_out(i)             = qtsrc_s
        1969           0 :                thlsrc_out(i)            = thlsrc_s
        1970           0 :                thvlsrc_out(i)           = thvlsrc_s
        1971           0 :                emfkbup_out(i)           = emfkbup_s
        1972           0 :                cbmflimit_out(i)         = cbmflimit_s
        1973           0 :                tkeavg_out(i)            = tkeavg_s
        1974           0 :                zinv_out(i)              = zinv_s
        1975           0 :                rcwp_out(i)              = rcwp_s
        1976           0 :                rlwp_out(i)              = rlwp_s
        1977           0 :                riwp_out(i)              = riwp_s
        1978             :
        1979           0 :                wu_out(i,mkx:0:-1)       = wu_s(0:mkx)
        1980           0 :                qtu_out(i,mkx:0:-1)      = qtu_s(0:mkx)
        1981           0 :                thlu_out(i,mkx:0:-1)     = thlu_s(0:mkx)
        1982           0 :                thvu_out(i,mkx:0:-1)     = thvu_s(0:mkx)
        1983           0 :                uu_out(i,mkx:0:-1)       = uu_s(0:mkx)
        1984           0 :                vu_out(i,mkx:0:-1)       = vu_s(0:mkx)
        1985           0 :                qtu_emf_out(i,mkx:0:-1)  = qtu_emf_s(0:mkx)
        1986           0 :                thlu_emf_out(i,mkx:0:-1) = thlu_emf_s(0:mkx)
        1987           0 :                uu_emf_out(i,mkx:0:-1)   = uu_emf_s(0:mkx)
        1988           0 :                vu_emf_out(i,mkx:0:-1)   = vu_emf_s(0:mkx)
        1989           0 :                uemf_out(i,mkx:0:-1)     = uemf_s(0:mkx)
        1990             :
        1991           0 :                dwten_out(i,mkx:1:-1)    = dwten_s(:mkx)
        1992           0 :                diten_out(i,mkx:1:-1)    = diten_s(:mkx)
        1993           0 :                flxrain_out(i,mkx:0:-1)  = flxrain_s(0:mkx)
        1994           0 :                flxsnow_out(i,mkx:0:-1)  = flxsnow_s(0:mkx)
        1995           0 :                ntraprd_out(i,mkx:1:-1)  = ntraprd_s(:mkx)
        1996           0 :                ntsnprd_out(i,mkx:1:-1)  = ntsnprd_s(:mkx)
        1997             :
        1998           0 :                excessu_arr_out(i,mkx:1:-1)  = excessu_arr_s(:mkx)
        1999           0 :                excess0_arr_out(i,mkx:1:-1)  = excess0_arr_s(:mkx)
        2000           0 :                xc_arr_out(i,mkx:1:-1)       = xc_arr_s(:mkx)
        2001           0 :                aquad_arr_out(i,mkx:1:-1)    = aquad_arr_s(:mkx)
        2002           0 :                bquad_arr_out(i,mkx:1:-1)    = bquad_arr_s(:mkx)
        2003           0 :                cquad_arr_out(i,mkx:1:-1)    = cquad_arr_s(:mkx)
        2004           0 :                bogbot_arr_out(i,mkx:1:-1)   = bogbot_arr_s(:mkx)
        2005           0 :                bogtop_arr_out(i,mkx:1:-1)   = bogtop_arr_s(:mkx)
        2006             :
        2007           0 :                do m = 1, ncnst
        2008           0 :                   trflx_out(i,mkx:0:-1,m)   = trflx_s(0:mkx,m)
        2009           0 :                   tru_out(i,mkx:0:-1,m)     = tru_s(0:mkx,m)
        2010           0 :                   tru_emf_out(i,mkx:0:-1,m) = tru_emf_s(0:mkx,m)
        2011             :                enddo
        2012             :
        2013             :                id_exit = .false.
        2014             :                go to 333
        2015             :
        2016             :           endif
        2017             :
        2018             :        endif
        2019             :
        2020             :        ! ------------------------------------------------------------------ !
        2021             :        ! Define a release level, 'prel' and release layer, 'krel'.          !
        2022             :        ! 'prel' is the lowest level from which buoyancy sorting occurs, and !
        2023             :        ! 'krel' is the layer index containing 'prel' in it, similar to  the !
        2024             :        ! previous definitions of 'kinv', 'klcl', and 'klfc'.    In order to !
        2025             :        ! ensure that only PBL scheme works within the PBL,  if LCL is below !
        2026             :        ! PBL top height, then 'krel = kinv', while if LCL is above  PBL top !
        2027             :        ! height, then 'krel = klcl'.   Note however that regardless of  the !
        2028             :        ! definition of 'krel', cumulus convection induces fluxes within PBL !
        2029             :        ! through 'fluxbelowinv'.  We can make cumulus convection start from !
        2030             :        ! any level, even within the PBL by appropriately defining 'krel'  & !
        2031             :        ! 'prel' here. Then it must be accompanied by appropriate definition !
        2032             :        ! of source air properties, CIN, and re-setting of 'fluxbelowinv', & !
        2033             :        ! many other stuffs.                                                 !
        2034             :        ! Note that even when 'prel' is located above the PBL top height, we !
        2035             :        ! still have cumulus convection between PBL top height and 'prel':   !
        2036             :        ! we simply assume that no lateral mixing occurs in this range.      !
        2037             :        ! ------------------------------------------------------------------ !
        2038             :
        2039           0 :        if( klcl .lt. kinv ) then
        2040           0 :            krel    = kinv
        2041           0 :            prel    = ps0(krel-1)
        2042           0 :            thv0rel = thv0bot(krel)
        2043             :        else
        2044           0 :            krel    = klcl
        2045           0 :            prel    = plcl
        2046           0 :            thv0rel = thv0lcl
        2047             :        endif
        2048             :
        2049             :        ! --------------------------------------------------------------------------- !
        2050             :        ! Calculate cumulus base mass flux ('cbmf'), fractional area ('ufrcinv'), and !
        2051             :        ! and mean vertical velocity (winv) of cumulus updraft at PBL top interface.  !
        2052             :        ! Also, calculate updraft fractional area (ufrclcl) and vertical velocity  at !
        2053             :        ! the LCL (wlcl). When LCL is below PBLH, cinlcl = 0 and 'ufrclcl = ufrcinv', !
        2054             :        ! and 'wlcl = winv.                                                           !
        2055             :        ! Only updrafts strong enough to overcome CIN can rise over PBL top interface.!
        2056             :        ! Thus,  in order to calculate cumulus mass flux at PBL top interface, 'cbmf',!
        2057             :        ! we need to know 'CIN' ( the strength of potential energy barrier ) and      !
        2058             :        ! 'sigmaw' ( a standard deviation of updraft vertical velocity at the PBL top !
        2059             :        ! interface, a measure of turbulentce strength in the PBL ).   Naturally, the !
        2060             :        ! ratio of these two variables, 'mu' - normalized CIN by TKE- is key variable !
        2061             :        ! controlling 'cbmf'.  If 'mu' becomes large, only small fraction of updrafts !
        2062             :        ! with very strong TKE can rise over the PBL - both 'cbmf' and 'ufrc' becomes !
        2063             :        ! small, but 'winv' becomes large ( this can be easily understood by PDF of w !
        2064             :        ! at PBL top ).  If 'mu' becomes small, lots of updraft can rise over the PBL !
        2065             :        ! top - both 'cbmf' and 'ufrc' becomes large, but 'winv' becomes small. Thus, !
        2066             :        ! all of the key variables associated with cumulus convection  at the PBL top !
        2067             :        ! - 'cbmf', 'ufrc', 'winv' where 'cbmf = rho*ufrc*winv' - are a unique functi !
        2068             :        ! ons of 'mu', normalized CIN. Although these are uniquely determined by 'mu',!
        2069             :        ! we usually impose two comstraints on 'cbmf' and 'ufrc': (1) because we will !
        2070             :        ! simply assume that subsidence warming and drying of 'kinv-1' layer in assoc !
        2071             :        ! iation with 'cbmf' at PBL top interface is confined only in 'kinv-1' layer, !
        2072             :        ! cbmf must not be larger than the mass within the 'kinv-1' layer. Otherwise, !
        2073             :        ! instability will occur due to the breaking of stability con. If we consider !
        2074             :        ! semi-Lagrangian vertical advection scheme and explicitly consider the exten !
        2075             :        ! t of vertical movement of each layer in association with cumulus mass flux, !
        2076             :        ! we don't need to impose this constraint. However,  using a  semi-Lagrangian !
        2077             :        ! scheme is a future research subject. Note that this constraint should be ap !
        2078             :        ! plied for all interfaces above PBL top as well as PBL top interface.   As a !
        2079             :        ! result, this 'cbmf' constraint impose a 'lower' limit on mu - 'mumin0'. (2) !
        2080             :        ! in order for mass flux parameterization - rho*(w'a')= M*(a_c-a_e) - to   be !
        2081             :        ! valid, cumulus updraft fractional area should be much smaller than 1.    In !
        2082             :        ! current code, we impose 'rmaxfrac = 0.1 ~ 0.2'   through the whole vertical !
        2083             :        ! layers where cumulus convection occurs. At the PBL top interface,  the same !
        2084             :        ! constraint is made by imposing another lower 'lower' limit on mu, 'mumin1'. !
        2085             :        ! After that, also limit 'ufrclcl' to be smaller than 'rmaxfrac' by 'mumin2'. !
        2086             :        ! --------------------------------------------------------------------------- !
        2087             :
        2088             :        ! --------------------------------------------------------------------------- !
        2089             :        ! Calculate normalized CIN, 'mu' satisfying all the three constraints imposed !
        2090             :        ! on 'cbmf'('mumin0'), 'ufrc' at the PBL top - 'ufrcinv' - ( by 'mumin1' from !
        2091             :        ! a parameter sentence), and 'ufrc' at the LCL - 'ufrclcl' ( by 'mumin2').    !
        2092             :        ! Note that 'cbmf' does not change between PBL top and LCL  because we assume !
        2093             :        ! that buoyancy sorting does not occur when cumulus updraft is unsaturated.   !
        2094             :        ! --------------------------------------------------------------------------- !
        2095             :
        2096             :        if( use_CINcin ) then
        2097           0 :            wcrit = sqrt( 2._r8 * cin * rbuoy )
        2098             :        else
        2099             :            wcrit = sqrt( 2._r8 * cinlcl * rbuoy )
        2100             :        endif
        2101           0 :        sigmaw = sqrt( rkfre * tkeavg + epsvarw )
        2102           0 :        mu = wcrit/sigmaw/1.4142_r8
        2103           0 :        if( mu .ge. 3._r8 ) then
        2104             :          ! write(iulog,*) 'mu >= 3'
        2105             :            id_exit = .true.
        2106             :            go to 333
        2107             :        endif
        2108           0 :        rho0inv = ps0(kinv-1)/(r*thv0top(kinv-1)*exns0(kinv-1))
        2109           0 :        cbmf = (rho0inv*sigmaw/2.5066_r8)*exp(-mu**2)
        2110             :        ! 1. 'cbmf' constraint
        2111           0 :        cbmflimit = 0.9_r8*dp0(kinv-1)/g/dt
        2112           0 :        mumin0 = 0._r8
        2113           0 :        if( cbmf .gt. cbmflimit ) mumin0 = sqrt(-log(2.5066_r8*cbmflimit/rho0inv/sigmaw))
        2114             :        ! 2. 'ufrcinv' constraint
        2115           0 :        mu = max(max(mu,mumin0),mumin1)
        2116             :        ! 3. 'ufrclcl' constraint
        2117           0 :        mulcl = sqrt(2._r8*cinlcl*rbuoy)/1.4142_r8/sigmaw
        2118           0 :        mulclstar = sqrt(max(0._r8,2._r8*(exp(-mu**2)/2.5066_r8)**2*(1._r8/erfc(mu)**2-0.25_r8/rmaxfrac**2)))
        2119           0 :        if( mulcl .gt. 1.e-8_r8 .and. mulcl .gt. mulclstar ) then
        2120           0 :            mumin2 = compute_mumin2(mulcl,rmaxfrac,mu)
        2121           0 :            if( mu .gt. mumin2 ) then
        2122           0 :                write(iulog,*) 'Critical error in mu calculation in UW_ShCu'
        2123           0 :                call endrun
        2124             :            endif
        2125           0 :            mu = max(mu,mumin2)
        2126           0 :            if( mu .eq. mumin2 ) limit_ufrc(i) = 1._r8
        2127             :        endif
        2128           0 :        if( mu .eq. mumin0 ) limit_cbmf(i) = 1._r8
        2129           0 :        if( mu .eq. mumin1 ) limit_ufrc(i) = 1._r8
        2130             :
        2131             :        ! ------------------------------------------------------------------- !
        2132             :        ! Calculate final ['cbmf','ufrcinv','winv'] at the PBL top interface. !
        2133             :        ! Note that final 'cbmf' here is obtained in such that 'ufrcinv' and  !
        2134             :        ! 'ufrclcl' are smaller than ufrcmax with no instability.             !
        2135             :        ! ------------------------------------------------------------------- !
        2136             :
        2137           0 :        cbmf = (rho0inv*sigmaw/2.5066_r8)*exp(-mu**2)
        2138           0 :        winv = sigmaw*(2._r8/2.5066_r8)*exp(-mu**2)/erfc(mu)
        2139           0 :        ufrcinv = cbmf/winv/rho0inv
        2140             :
        2141             :        ! ------------------------------------------------------------------- !
        2142             :        ! Calculate ['ufrclcl','wlcl'] at the LCL. When LCL is below PBL top, !
        2143             :        ! it automatically becomes 'ufrclcl = ufrcinv' & 'wlcl = winv', since !
        2144             :        ! it was already set to 'cinlcl=0' if LCL is below PBL top interface. !
        2145             :        ! Note 'cbmf' at the PBL top is the same as 'cbmf' at the LCL.  Note  !
        2146             :        ! also that final 'cbmf' here is obtained in such that 'ufrcinv' and  !
        2147             :        ! 'ufrclcl' are smaller than ufrcmax and there is no instability.     !
        2148             :        ! By construction, it must be 'wlcl > 0' but for assurance, I checked !
        2149             :        ! this again in the below block. If 'ufrclcl < 0.1%', just exit.      !
        2150             :        ! ------------------------------------------------------------------- !
        2151             :
        2152           0 :        wtw = winv * winv - 2._r8 * cinlcl * rbuoy
        2153           0 :        if( wtw .le. 0._r8 ) then
        2154             :          ! write(iulog,*) 'wlcl < 0 at the LCL'
        2155           0 :            exit_wtw(i) = 1._r8
        2156           0 :            id_exit = .true.
        2157           0 :            go to 333
        2158             :        endif
        2159           0 :        wlcl = sqrt(wtw)
        2160           0 :        ufrclcl = cbmf/wlcl/rho0inv
        2161           0 :        wrel = wlcl
        2162           0 :        if( ufrclcl .le. 0.0001_r8 ) then
        2163             :          ! write(iulog,*) 'ufrclcl <= 0.0001'
        2164           0 :            exit_ufrc(i) = 1._r8
        2165           0 :            id_exit = .true.
        2166           0 :            go to 333
        2167             :        endif
        2168           0 :        ufrc(krel-1) = ufrclcl
        2169             :
        2170             :        ! ----------------------------------------------------------------------- !
        2171             :        ! Below is just diagnostic output for detailed analysis of cumulus scheme !
        2172             :        ! ----------------------------------------------------------------------- !
        2173             :
        2174           0 :        ufrcinvbase        = ufrcinv
        2175           0 :        winvbase           = winv
        2176           0 :        umf(kinv-1:krel-1) = cbmf
        2177           0 :        wu(kinv-1:krel-1)  = winv
        2178             :
        2179             :        ! -------------------------------------------------------------------------- !
        2180             :        ! Define updraft properties at the level where buoyancy sorting starts to be !
        2181             :        ! happening, i.e., by definition, at 'prel' level within the release layer.  !
        2182             :        ! Because no lateral entrainment occurs upto 'prel', conservative scalars of !
        2183             :        ! cumulus updraft at release level is same as those of source air.  However, !
        2184             :        ! horizontal momentums of source air are modified by horizontal PGF forcings !
        2185             :        ! from PBL top interface to 'prel'.  For this case, we should add additional !
        2186             :        ! horizontal momentum from PBL top interface to 'prel' as will be done below !
        2187             :        ! to 'usrc' and 'vsrc'. Note that below cumulus updraft properties - umf, wu,!
        2188             :        ! thlu, qtu, thvu, uu, vu - are defined all interfaces not at the layer mid- !
        2189             :        ! point. From the index notation of cumulus scheme, wu(k) is the cumulus up- !
        2190             :        ! draft vertical velocity at the top interface of k layer.                   !
        2191             :        ! Diabatic horizontal momentum forcing should be treated as a kind of 'body' !
        2192             :        ! forcing without actual mass exchange between convective updraft and        !
        2193             :        ! environment, but still taking horizontal momentum from the environment to  !
        2194             :        ! the convective updrafts. Thus, diabatic convective momentum transport      !
        2195             :        ! vertically redistributes environmental horizontal momentum.                !
        2196             :        ! -------------------------------------------------------------------------- !
        2197             :
        2198           0 :        emf(krel-1)  = 0._r8
        2199           0 :        umf(krel-1)  = cbmf
        2200           0 :        wu(krel-1)   = wrel
        2201           0 :        thlu(krel-1) = thlsrc
        2202           0 :        qtu(krel-1)  = qtsrc
        2203           0 :        call conden(prel,thlsrc,qtsrc,thj,qvj,qlj,qij,qse,id_check)
        2204           0 :        if( id_check .eq. 1 ) then
        2205           0 :            exit_conden(i) = 1._r8
        2206           0 :            id_exit = .true.
        2207           0 :            go to 333
        2208             :        endif
        2209           0 :        thvu(krel-1) = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        2210             :
        2211           0 :        uplus = 0._r8
        2212           0 :        vplus = 0._r8
        2213           0 :        if( krel .eq. kinv ) then
        2214           0 :            uplus = PGFc * ssu0(kinv) * ( prel - ps0(kinv-1) )
        2215           0 :            vplus = PGFc * ssv0(kinv) * ( prel - ps0(kinv-1) )
        2216             :        else
        2217           0 :            do k = kinv, max(krel-1,kinv)
        2218           0 :               uplus = uplus + PGFc * ssu0(k) * ( ps0(k) - ps0(k-1) )
        2219           0 :               vplus = vplus + PGFc * ssv0(k) * ( ps0(k) - ps0(k-1) )
        2220             :            end do
        2221           0 :            uplus = uplus + PGFc * ssu0(krel) * ( prel - ps0(krel-1) )
        2222           0 :            vplus = vplus + PGFc * ssv0(krel) * ( prel - ps0(krel-1) )
        2223             :        end if
        2224           0 :        uu(krel-1) = usrc + uplus
        2225           0 :        vu(krel-1) = vsrc + vplus
        2226             :
        2227           0 :        do m = 1, ncnst
        2228           0 :           tru(krel-1,m)  = trsrc(m)
        2229             :        enddo
        2230             :
        2231             :        ! -------------------------------------------------------------------------- !
        2232             :        ! Define environmental properties at the level where buoyancy sorting occurs !
        2233             :        ! ('pe', normally, layer midpoint except in the 'krel' layer). In the 'krel' !
        2234             :        ! layer where buoyancy sorting starts to occur, however, 'pe' is defined     !
        2235             :        ! differently because LCL is regarded as lower interface for mixing purpose. !
        2236             :        ! -------------------------------------------------------------------------- !
        2237             :
        2238           0 :        pe      = 0.5_r8 * ( prel + ps0(krel) )
        2239           0 :        dpe     = prel - ps0(krel)
        2240           0 :        exne    = exnf(pe)
        2241           0 :        thvebot = thv0rel
        2242           0 :        thle    = thl0(krel) + ssthl0(krel) * ( pe - p0(krel) )
        2243           0 :        qte     = qt0(krel)  + ssqt0(krel)  * ( pe - p0(krel) )
        2244           0 :        ue      = u0(krel)   + ssu0(krel)   * ( pe - p0(krel) )
        2245           0 :        ve      = v0(krel)   + ssv0(krel)   * ( pe - p0(krel) )
        2246           0 :        do m = 1, ncnst
        2247           0 :           tre(m) = tr0(krel,m)  + sstr0(krel,m) * ( pe - p0(krel) )
        2248             :        enddo
        2249             :
        2250             :        !-------------------------!
        2251             :        ! Buoyancy-Sorting Mixing !
        2252             :        !-------------------------!------------------------------------------------ !
        2253             :        !                                                                           !
        2254             :        !  In order to complete buoyancy-sorting mixing at layer mid-point, and so  !
        2255             :        !  calculate 'updraft mass flux, updraft w velocity, conservative scalars'  !
        2256             :        !  at the upper interface of each layer, we need following 3 information.   !
        2257             :        !                                                                           !
        2258             :        !  1. Pressure where mixing occurs ('pe'), and temperature at 'pe' which is !
        2259             :        !     necessary to calculate various thermodynamic coefficients at pe. This !
        2260             :        !     temperature is obtained by undiluted cumulus properties lifted to pe. !
        2261             :        !  2. Undiluted updraft properties at pe - conservative scalar and vertical !
        2262             :        !     velocity -which are assumed to be the same as the properties at lower !
        2263             :        !     interface only for calculation of fractional lateral entrainment  and !
        2264             :        !     detrainment rate ( fer(k) and fdr(k) [Pa-1] ), respectively.    Final !
        2265             :        !     values of cumulus conservative scalars and w at the top interface are !
        2266             :        !     calculated afterward after obtaining fer(k) & fdr(k).                 !
        2267             :        !  3. Environmental properties at pe.                                       !
        2268             :        ! ------------------------------------------------------------------------- !
        2269             :
        2270             :        ! ------------------------------------------------------------------------ !
        2271             :        ! Define cumulus scale height.                                             !
        2272             :        ! Cumulus scale height is defined as the maximum height cumulus can reach. !
        2273             :        ! In case of premitive code, cumulus scale height ('cush')  at the current !
        2274             :        ! time step was assumed to be the same as 'cush' of previous time step.    !
        2275             :        ! However, I directly calculated cush at each time step using an iterative !
        2276             :        ! method. Note that within the cumulus scheme, 'cush' information is  used !
        2277             :        ! only at two places during buoyancy-sorting process:                      !
        2278             :        ! (1) Even negatively buoyancy mixtures with strong vertical velocity      !
        2279             :        !     enough to rise up to 'rle*scaleh' (rle = 0.1) from pe are entrained  !
        2280             :        !     into cumulus updraft,                                                !
        2281             :        ! (2) The amount of mass that is involved in buoyancy-sorting mixing       !
        2282             :        !      process at pe is rei(k) = rkm/scaleh/rho*g [Pa-1]                   !
        2283             :        ! In terms of (1), I think critical stopping distance might be replaced by !
        2284             :        ! layer thickness. In future, we will use rei(k) = (0.5*rkm/z0(k)/rho/g).  !
        2285             :        ! In the premitive code,  'scaleh' was largely responsible for the jumping !
        2286             :        ! variation of precipitation amount.                                       !
        2287             :        ! ------------------------------------------------------------------------ !
        2288             :
        2289           0 :        scaleh = tscaleh
        2290           0 :        if( tscaleh .lt. 0.0_r8 ) scaleh = 1000._r8
        2291             :
        2292             :      ! Save time : Set iter_scaleh = 1. This will automatically use 'cush' from the previous time step
        2293             :      !             at the first implicit iteration. At the second implicit iteration, it will use
        2294             :      !             the updated 'cush' by the first implicit cin. So, this updating has an effect of
        2295             :      !             doing one iteration for cush calculation, which is good.
        2296             :      !             So, only this setting of 'iter_scaleh = 1' is sufficient-enough to save computation time.
        2297             :      ! OK
        2298             :
        2299           0 :        do iter_scaleh = 1, 3
        2300             :
        2301             :        ! ---------------------------------------------------------------- !
        2302             :        ! Initialization of 'kbup' and 'kpen'                              !
        2303             :        ! ---------------------------------------------------------------- !
        2304             :        ! 'kbup' is the top-most layer in which cloud buoyancy is positive !
        2305             :        ! both at the top and bottom interface of the layer. 'kpen' is the !
        2306             :        ! layer upto which cumulus panetrates ,i.e., cumulus w at the base !
        2307             :        ! interface is positive, but becomes negative at the top interface.!
        2308             :        ! Here, we initialize 'kbup' and 'kpen'. These initializations are !
        2309             :        ! not trivial but important, expecially   in calculating turbulent !
        2310             :        ! fluxes without confliction among several physics as explained in !
        2311             :        ! detail in the part of turbulent fluxes calculation later.   Note !
        2312             :        ! that regardless of whether 'kbup' and 'kpen' are updated or  not !
        2313             :        ! during updraft motion,  penetrative entrainments are dumped down !
        2314             :        ! across the top interface of 'kbup' later.      More specifically,!
        2315             :        ! penetrative entrainment heat and moisture fluxes are  calculated !
        2316             :        ! from the top interface of 'kbup' layer  to the base interface of !
        2317             :        ! 'kpen' layer. Because of this, initialization of 'kbup' & 'kpen' !
        2318             :        ! influence the convection system when there are not updated.  The !
        2319             :        ! below initialization of 'kbup = krel' assures  that  penetrative !
        2320             :        ! entrainment fluxes always occur at interfaces above the PBL  top !
        2321             :        ! interfaces (i.e., only at interfaces k >=kinv ), which seems  to !
        2322             :        ! be attractable considering that the most correct fluxes  at  the !
        2323             :        ! PBL top interface can be ontained from the 'fluxbelowinv'  using !
        2324             :        ! reconstructed PBL height.                                        !
        2325             :        ! The 'kbup = krel'(after going through the whole buoyancy sorting !
        2326             :        ! proces during updraft motion) implies that cumulus updraft  from !
        2327             :        ! the PBL top interface can not reach to the LFC,so that 'kbup' is !
        2328             :        ! not updated during upward. This means that cumulus updraft   did !
        2329             :        ! not fully overcome the buoyancy barrier above just the PBL top.  !
        2330             :        ! If 'kpen' is not updated either ( i.e., cumulus cannot rise over !
        2331             :        ! the top interface of release layer),penetrative entrainment will !
        2332             :        ! not happen at any interfaces.  If cumulus updraft can rise above !
        2333             :        ! the release layer but cannot fully overcome the buoyancy barrier !
        2334             :        ! just above PBL top interface, penetratve entrainment   occurs at !
        2335             :        ! several above interfaces, including the top interface of release !
        2336             :        ! layer. In the latter case, warming and drying tendencies will be !
        2337             :        ! be initiated in 'krel' layer. Note current choice of 'kbup=krel' !
        2338             :        ! is completely compatible with other flux physics without  double !
        2339             :        ! or miss counting turbulent fluxes at any interface. However, the !
        2340             :        ! alternative choice of 'kbup=krel-1' also has itw own advantage - !
        2341             :        ! when cumulus updraft cannot overcome buoyancy barrier just above !
        2342             :        ! PBL top, entrainment warming and drying are concentrated in  the !
        2343             :        ! 'kinv-1' layer instead of 'kinv' layer for this case. This might !
        2344             :        ! seems to be more dynamically reasonable, but I will choose the   !
        2345             :        ! 'kbup = krel' choice since it is more compatible  with the other !
        2346             :        ! parts of the code, expecially, when we chose ' use_emf=.false. ' !
        2347             :        ! as explained in detail in turbulent flux calculation part.       !
        2348             :        ! ---------------------------------------------------------------- !
        2349             :
        2350           0 :        kbup    = krel
        2351           0 :        kpen    = krel
        2352             :
        2353             :        ! ------------------------------------------------------------ !
        2354             :        ! Since 'wtw' is continuously updated during vertical motion,  !
        2355             :        ! I need below initialization command within this 'iter_scaleh'!
        2356             :        ! do loop. Similarily, I need initializations of environmental !
        2357             :        ! properties at 'krel' layer as below.                         !
        2358             :        ! ------------------------------------------------------------ !
        2359             :
        2360           0 :        wtw     = wlcl * wlcl
        2361           0 :        pe      = 0.5_r8 * ( prel + ps0(krel) )
        2362           0 :        dpe     = prel - ps0(krel)
        2363           0 :        exne    = exnf(pe)
        2364           0 :        thvebot = thv0rel
        2365           0 :        thle    = thl0(krel) + ssthl0(krel) * ( pe - p0(krel) )
        2366           0 :        qte     = qt0(krel)  + ssqt0(krel)  * ( pe - p0(krel) )
        2367           0 :        ue      = u0(krel)   + ssu0(krel)   * ( pe - p0(krel) )
        2368           0 :        ve      = v0(krel)   + ssv0(krel)   * ( pe - p0(krel) )
        2369           0 :        do m = 1, ncnst
        2370           0 :           tre(m) = tr0(krel,m)  + sstr0(krel,m)  * ( pe - p0(krel) )
        2371             :        enddo
        2372             :
        2373             :        ! ----------------------------------------------------------------------- !
        2374             :        ! Cumulus rises upward from 'prel' ( or base interface of  'krel' layer ) !
        2375             :        ! until updraft vertical velocity becomes zero.                           !
        2376             :        ! Buoyancy sorting is performed via two stages. (1) Using cumulus updraft !
        2377             :        ! properties at the base interface of each layer,perform buoyancy sorting !
        2378             :        ! at the layer mid-point, 'pe',  and update cumulus properties at the top !
        2379             :        ! interface, and then  (2) by averaging updated cumulus properties at the !
        2380             :        ! top interface and cumulus properties at the base interface,   calculate !
        2381             :        ! cumulus updraft properties at pe that will be used  in buoyancy sorting !
        2382             :        ! mixing - thlue, qtue and, wue.  Using this averaged properties, perform !
        2383             :        ! buoyancy sorting again at pe, and re-calculate fer(k) and fdr(k). Using !
        2384             :        ! this recalculated fer(k) and fdr(k),  finally calculate cumulus updraft !
        2385             :        ! properties at the top interface - thlu, qtu, thvu, uu, vu. In the below,!
        2386             :        ! 'iter_xc = 1' performs the first stage, while 'iter_xc= 2' performs the !
        2387             :        ! second stage. We can increase the number of iterations, 'nter_xc'.as we !
        2388             :        ! want, but a sample test indicated that about 3 - 5 iterations  produced !
        2389             :        ! satisfactory converent solution. Finally, identify 'kbup' and 'kpen'.   !
        2390             :        ! ----------------------------------------------------------------------- !
        2391             :
        2392           0 :        do k = krel, mkx - 1 ! Here, 'k' is a layer index.
        2393             :
        2394           0 :           km1 = k - 1
        2395             :
        2396           0 :           thlue = thlu(km1)
        2397           0 :           qtue  = qtu(km1)
        2398           0 :           wue   = wu(km1)
        2399           0 :           wtwb  = wtw
        2400             :
        2401           0 :        do iter_xc = 1, niter_xc
        2402             :
        2403           0 :           wtw = wu(km1) * wu(km1)
        2404             :
        2405             :           ! ---------------------------------------------------------------- !
        2406             :           ! Calculate environmental and cumulus saturation 'excess' at 'pe'. !
        2407             :           ! Note that in order to calculate saturation excess, we should use !
        2408             :           ! liquid water temperature instead of temperature  as the argument !
        2409             :           ! of "qsat". But note normal argument of "qsat" is temperature.    !
        2410             :           ! ---------------------------------------------------------------- !
        2411             :
        2412           0 :           call conden(pe,thle,qte,thj,qvj,qlj,qij,qse,id_check)
        2413           0 :           if( id_check .eq. 1 ) then
        2414           0 :               exit_conden(i) = 1._r8
        2415           0 :               id_exit = .true.
        2416           0 :               go to 333
        2417             :           end if
        2418           0 :           thv0j    = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        2419           0 :           rho0j    = pe / ( r * thv0j * exne )
        2420           0 :           qsat_arg = thle*exne
        2421           0 :           call qsat(qsat_arg, pe, es, qs)
        2422           0 :           excess0  = qte - qs
        2423             :
        2424           0 :           call conden(pe,thlue,qtue,thj,qvj,qlj,qij,qse,id_check)
        2425           0 :           if( id_check .eq. 1 ) then
        2426           0 :               exit_conden(i) = 1._r8
        2427           0 :               id_exit = .true.
        2428           0 :               go to 333
        2429             :           end if
        2430             :           ! ----------------------------------------------------------------- !
        2431             :           ! Detrain excessive condensate larger than 'criqc' from the cumulus !
        2432             :           ! updraft before performing buoyancy sorting. All I should to do is !
        2433             :           ! to update 'thlue' &  'que' here. Below modification is completely !
        2434             :           ! compatible with the other part of the code since 'thule' & 'qtue' !
        2435             :           ! are used only for buoyancy sorting. I found that as long as I use !
        2436             :           ! 'niter_xc >= 2',  detraining excessive condensate before buoyancy !
        2437             :           ! sorting has negligible influence on the buoyancy sorting results. !
        2438             :           ! ----------------------------------------------------------------- !
        2439           0 :           if( (qlj + qij) .gt. criqc ) then
        2440           0 :                exql  = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij )
        2441           0 :                exqi  = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij )
        2442           0 :                qtue  = qtue - exql - exqi
        2443           0 :                thlue = thlue + (xlv/cp/exne)*exql + (xls/cp/exne)*exqi
        2444             :           endif
        2445           0 :           call conden(pe,thlue,qtue,thj,qvj,qlj,qij,qse,id_check)
        2446           0 :           if( id_check .eq. 1 ) then
        2447           0 :               exit_conden(i) = 1._r8
        2448           0 :               id_exit = .true.
        2449           0 :               go to 333
        2450             :           end if
        2451           0 :           thvj     = thj * ( 1._r8 + zvir * qvj - qlj - qij )
        2452           0 :           tj       = thj * exne ! This 'tj' is used for computing thermo. coeffs. below
        2453           0 :           qsat_arg = thlue*exne
        2454           0 :           call qsat(qsat_arg, pe, es, qs)
        2455           0 :           excessu  = qtue - qs
        2456             :
        2457             :           ! ------------------------------------------------------------------- !
        2458             :           ! Calculate critical mixing fraction, 'xc'. Mixture with mixing ratio !
        2459             :           ! smaller than 'xc' will be entrained into cumulus updraft.  Both the !
        2460             :           ! saturated updrafts with 'positive buoyancy' or 'negative buoyancy + !
        2461             :           ! strong vertical velocity enough to rise certain threshold distance' !
        2462             :           ! are kept into the updraft in the below program. If the core updraft !
        2463             :           ! is unsaturated, we can set 'xc = 0' and let the cumulus  convection !
        2464             :           ! still works or we may exit.                                         !
        2465             :           ! Current below code does not entrain unsaturated mixture. However it !
        2466             :           ! should be modified such that it also entrain unsaturated mixture.   !
        2467             :           ! ------------------------------------------------------------------- !
        2468             :
        2469             :           ! ----------------------------------------------------------------- !
        2470             :           ! cridis : Critical stopping distance for buoyancy sorting purpose. !
        2471             :           !          scaleh is only used here.                                !
        2472             :           ! ----------------------------------------------------------------- !
        2473             :
        2474           0 :             cridis = rle*scaleh                 ! Original code
        2475             :           ! cridis = 1._r8*(zs0(k) - zs0(k-1))  ! New code
        2476             :
        2477             :           ! ---------------- !
        2478             :           ! Buoyancy Sorting !
        2479             :           ! ---------------- !
        2480             :
        2481             :           ! ----------------------------------------------------------------- !
        2482             :           ! Case 1 : When both cumulus and env. are unsaturated or saturated. !
        2483             :           ! ----------------------------------------------------------------- !
        2484             :
        2485           0 :           if( ( excessu .le. 0._r8 .and. excess0 .le. 0._r8 ) .or. ( excessu .ge. 0._r8 .and. excess0 .ge. 0._r8 ) ) then
        2486           0 :                 xc = min(1._r8,max(0._r8,1._r8-2._r8*rbuoy*g*cridis/wue**2._r8*(1._r8-thvj/thv0j)))
        2487             :               ! Below 3 lines are diagnostic output not influencing
        2488             :               ! numerical calculations.
        2489           0 :                 aquad = 0._r8
        2490           0 :                 bquad = 0._r8
        2491           0 :                 cquad = 0._r8
        2492             :           else
        2493             :           ! -------------------------------------------------- !
        2494             :           ! Case 2 : When either cumulus or env. is saturated. !
        2495             :           ! -------------------------------------------------- !
        2496           0 :               xsat    = excessu / ( excessu - excess0 );
        2497           0 :               thlxsat = thlue + xsat * ( thle - thlue );
        2498           0 :               qtxsat  = qtue  + xsat * ( qte - qtue );
        2499           0 :               call conden(pe,thlxsat,qtxsat,thj,qvj,qlj,qij,qse,id_check)
        2500           0 :               if( id_check .eq. 1 ) then
        2501           0 :                   exit_conden(i) = 1._r8
        2502           0 :                   id_exit = .true.
        2503           0 :                   go to 333
        2504             :               end if
        2505           0 :               thvxsat = thj * ( 1._r8 + zvir * qvj - qlj - qij )
        2506             :               ! -------------------------------------------------- !
        2507             :               ! kk=1 : Cumulus Segment, kk=2 : Environment Segment !
        2508             :               ! -------------------------------------------------- !
        2509           0 :               do kk = 1, 2
        2510           0 :                    if( kk .eq. 1 ) then
        2511           0 :                        thv_x0 = thvj;
        2512           0 :                        thv_x1 = ( 1._r8 - 1._r8/xsat ) * thvj + ( 1._r8/xsat ) * thvxsat;
        2513             :                    else
        2514           0 :                        thv_x1 = thv0j;
        2515           0 :                        thv_x0 = ( xsat / ( xsat - 1._r8 ) ) * thv0j + ( 1._r8/( 1._r8 - xsat ) ) * thvxsat;
        2516             :                    endif
        2517           0 :                    aquad =  wue**2;
        2518           0 :                    bquad =  2._r8*rbuoy*g*cridis*(thv_x1 - thv_x0)/thv0j - 2._r8*wue**2;
        2519           0 :                    cquad =  2._r8*rbuoy*g*cridis*(thv_x0 -  thv0j)/thv0j +       wue**2;
        2520           0 :                    if( kk .eq. 1 ) then
        2521           0 :                        if( ( bquad**2-4._r8*aquad*cquad ) .ge. 0._r8 ) then
        2522           0 :                              call roots(aquad,bquad,cquad,xs1,xs2,status)
        2523           0 :                              x_cu = min(1._r8,max(0._r8,min(xsat,min(xs1,xs2))))
        2524             :                        else
        2525             :                              x_cu = xsat;
        2526             :                        endif
        2527             :                    else
        2528           0 :                        if( ( bquad**2-4._r8*aquad*cquad) .ge. 0._r8 ) then
        2529           0 :                              call roots(aquad,bquad,cquad,xs1,xs2,status)
        2530           0 :                              x_en = min(1._r8,max(0._r8,max(xsat,min(xs1,xs2))))
        2531             :                        else
        2532             :                              x_en = 1._r8;
        2533             :                        endif
        2534             :                    endif
        2535             :               enddo
        2536           0 :               if( x_cu .eq. xsat ) then
        2537           0 :                   xc = max(x_cu, x_en);
        2538             :               else
        2539             :                   xc = x_cu;
        2540             :               endif
        2541             :           endif
        2542             :
        2543             :           ! ------------------------------------------------------------------------ !
        2544             :           ! Compute fractional lateral entrainment & detrainment rate in each layers.!
        2545             :           ! The unit of rei(k), fer(k), and fdr(k) is [Pa-1].  Alternative choice of !
        2546             :           ! 'rei(k)' is also shown below, where coefficient 0.5 was from approximate !
        2547             :           ! tuning against the BOMEX case.                                           !
        2548             :           ! In order to prevent the onset of instability in association with cumulus !
        2549             :           ! induced subsidence advection, cumulus mass flux at the top interface  in !
        2550             :           ! any layer should be smaller than ( 90% of ) total mass within that layer.!
        2551             :           ! I imposed limits on 'rei(k)' as below,  in such that stability condition !
        2552             :           ! is always satisfied.                                                     !
        2553             :           ! Below limiter of 'rei(k)' becomes negative for some cases, causing error.!
        2554             :           ! So, for the time being, I came back to the original limiter.             !
        2555             :           ! ------------------------------------------------------------------------ !
        2556           0 :           ee2    = xc**2
        2557           0 :           ud2    = 1._r8 - 2._r8*xc + xc**2
        2558             :         ! rei(k) = ( rkm / scaleh / g / rho0j )        ! Default.
        2559           0 :           rei(k) = ( 0.5_r8 * rkm / z0(k) / g /rho0j ) ! Alternative.
        2560           0 :           if( xc .gt. 0.5_r8 ) rei(k) = min(rei(k),0.9_r8*log(dp0(k)/g/dt/umf(km1) + 1._r8)/dpe/(2._r8*xc-1._r8))
        2561           0 :           fer(k) = rei(k) * ee2
        2562           0 :           fdr(k) = rei(k) * ud2
        2563             :
        2564             :           ! ------------------------------------------------------------------------------ !
        2565             :           ! Iteration Start due to 'maxufrc' constraint [ ****************************** ] !
        2566             :           ! ------------------------------------------------------------------------------ !
        2567             :
        2568             :           ! -------------------------------------------------------------------------- !
        2569             :           ! Calculate cumulus updraft mass flux and penetrative entrainment mass flux. !
        2570             :           ! Note that  non-zero penetrative entrainment mass flux will be asigned only !
        2571             :           ! to interfaces from the top interface of 'kbup' layer to the base interface !
        2572             :           ! of 'kpen' layer as will be shown later.                                    !
        2573             :           ! -------------------------------------------------------------------------- !
        2574             :
        2575           0 :           umf(k) = umf(km1) * exp( dpe * ( fer(k) - fdr(k) ) )
        2576           0 :           emf(k) = 0._r8
        2577             :
        2578             :           ! --------------------------------------------------------- !
        2579             :           ! Compute cumulus updraft properties at the top interface.  !
        2580             :           ! Also use Tayler expansion in order to treat limiting case !
        2581             :           ! --------------------------------------------------------- !
        2582             :
        2583           0 :           if( fer(k)*dpe .lt. 1.e-4_r8 ) then
        2584           0 :               thlu(k) = thlu(km1) + ( thle + ssthl0(k) * dpe / 2._r8 - thlu(km1) ) * fer(k) * dpe
        2585           0 :               qtu(k)  =  qtu(km1) + ( qte  +  ssqt0(k) * dpe / 2._r8 -  qtu(km1) ) * fer(k) * dpe
        2586           0 :               uu(k)   =   uu(km1) + ( ue   +   ssu0(k) * dpe / 2._r8 -   uu(km1) ) * fer(k) * dpe - PGFc * ssu0(k) * dpe
        2587           0 :               vu(k)   =   vu(km1) + ( ve   +   ssv0(k) * dpe / 2._r8 -   vu(km1) ) * fer(k) * dpe - PGFc * ssv0(k) * dpe
        2588           0 :               do m = 1, ncnst
        2589           0 :                  tru(k,m)  =  tru(km1,m) + ( tre(m)  + sstr0(k,m) * dpe / 2._r8  -  tru(km1,m) ) * fer(k) * dpe
        2590             :               enddo
        2591             :           else
        2592             :               thlu(k) = ( thle + ssthl0(k) / fer(k) - ssthl0(k) * dpe / 2._r8 ) -          &
        2593           0 :                         ( thle + ssthl0(k) * dpe / 2._r8 - thlu(km1) + ssthl0(k) / fer(k) ) * exp(-fer(k) * dpe)
        2594             :               qtu(k)  = ( qte  +  ssqt0(k) / fer(k) -  ssqt0(k) * dpe / 2._r8 ) -          &
        2595           0 :                         ( qte  +  ssqt0(k) * dpe / 2._r8 -  qtu(km1) +  ssqt0(k) / fer(k) ) * exp(-fer(k) * dpe)
        2596             :               uu(k) =   ( ue + ( 1._r8 - PGFc ) * ssu0(k) / fer(k) - ssu0(k) * dpe / 2._r8 ) - &
        2597           0 :                         ( ue +     ssu0(k) * dpe / 2._r8 -   uu(km1) + ( 1._r8 - PGFc ) * ssu0(k) / fer(k) ) * exp(-fer(k) * dpe)
        2598             :               vu(k) =   ( ve + ( 1._r8 - PGFc ) * ssv0(k) / fer(k) - ssv0(k) * dpe / 2._r8 ) - &
        2599           0 :                         ( ve +     ssv0(k) * dpe / 2._r8 -   vu(km1) + ( 1._r8 - PGFc ) * ssv0(k) / fer(k) ) * exp(-fer(k) * dpe)
        2600           0 :               do m = 1, ncnst
        2601           0 :                  tru(k,m)  = ( tre(m)  + sstr0(k,m) / fer(k) - sstr0(k,m) * dpe / 2._r8 ) - &
        2602           0 :                              ( tre(m)  + sstr0(k,m) * dpe / 2._r8 - tru(km1,m) + sstr0(k,m) / fer(k) ) * exp(-fer(k) * dpe)
        2603             :               enddo
        2604             :           end if
        2605             :
        2606             :           !------------------------------------------------------------------- !
        2607             :           ! Expel some of cloud water and ice from cumulus  updraft at the top !
        2608             :           ! interface.  Note that this is not 'detrainment' term  but a 'sink' !
        2609             :           ! term of cumulus updraft qt ( or one part of 'source' term of  mean !
        2610             :           ! environmental qt ). At this stage, as the most simplest choice, if !
        2611             :           ! condensate amount within cumulus updraft is larger than a critical !
        2612             :           ! value, 'criqc', expels the surplus condensate from cumulus updraft !
        2613             :           ! to the environment. A certain fraction ( e.g., 'frc_sus' ) of this !
        2614             :           ! expelled condesnate will be in a form that can be suspended in the !
        2615             :           ! layer k where it was formed, while the other fraction, '1-frc_sus' !
        2616             :           ! will be in a form of precipitatble (e.g.,can potentially fall down !
        2617             :           ! across the base interface of layer k ). In turn we should describe !
        2618             :           ! subsequent falling of precipitable condensate ('1-frc_sus') across !
        2619             :           ! the base interface of the layer k, &  evaporation of precipitating !
        2620             :           ! water in the below layer k-1 and associated evaporative cooling of !
        2621             :           ! the later, k-1, and falling of 'non-evaporated precipitating water !
        2622             :           ! ( which was initially formed in layer k ) and a newly-formed preci !
        2623             :           ! pitable water in the layer, k-1', across the base interface of the !
        2624             :           ! lower layer k-1.  Cloud microphysics should correctly describe all !
        2625             :           ! of these process.  In a near future, I should significantly modify !
        2626             :           ! this cloud microphysics, including precipitation-induced downdraft !
        2627             :           ! also.                                                              !
        2628             :           ! ------------------------------------------------------------------ !
        2629             :
        2630           0 :           call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check)
        2631           0 :           if( id_check .eq. 1 ) then
        2632           0 :               exit_conden(i) = 1._r8
        2633           0 :               id_exit = .true.
        2634           0 :               go to 333
        2635             :           end if
        2636           0 :           if( (qlj + qij) .gt. criqc ) then
        2637           0 :                exql    = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij )
        2638           0 :                exqi    = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij )
        2639             :                ! ---------------------------------------------------------------- !
        2640             :                ! It is very important to re-update 'qtu' and 'thlu'  at the upper !
        2641             :                ! interface after expelling condensate from cumulus updraft at the !
        2642             :                ! top interface of the layer. As mentioned above, this is a 'sink' !
        2643             :                ! of cumulus qt (or equivalently, a 'source' of environmentasl qt),!
        2644             :                ! not a regular convective'detrainment'.                           !
        2645             :                ! ---------------------------------------------------------------- !
        2646           0 :                qtu(k)  = qtu(k) - exql - exqi
        2647           0 :                thlu(k) = thlu(k) + (xlv/cp/exns0(k))*exql + (xls/cp/exns0(k))*exqi
        2648             :                ! ---------------------------------------------------------------- !
        2649             :                ! Expelled cloud condensate into the environment from the updraft. !
        2650             :                ! After all the calculation later, 'dwten' and 'diten' will have a !
        2651             :                ! unit of [ kg/kg/s ], because it is a tendency of qt. Restoration !
        2652             :                ! of 'dwten' and 'diten' to this correct unit through  multiplying !
        2653             :                ! 'umf(k)*g/dp0(k)' will be performed later after finally updating !
        2654             :                ! 'umf' using a 'rmaxfrac' constraint near the end of this updraft !
        2655             :                ! buoyancy sorting loop.                                           !
        2656             :                ! ---------------------------------------------------------------- !
        2657           0 :                dwten(k) = exql
        2658           0 :                diten(k) = exqi
        2659             :           else
        2660           0 :                dwten(k) = 0._r8
        2661           0 :                diten(k) = 0._r8
        2662             :           endif
        2663             :           ! ----------------------------------------------------------------- !
        2664             :           ! Update 'thvu(k)' after detraining condensate from cumulus updraft.!
        2665             :           ! ----------------------------------------------------------------- !
        2666           0 :           call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check)
        2667           0 :           if( id_check .eq. 1 ) then
        2668           0 :               exit_conden(i) = 1._r8
        2669           0 :               id_exit = .true.
        2670           0 :               go to 333
        2671             :           end if
        2672           0 :           thvu(k) = thj * ( 1._r8 + zvir * qvj - qlj - qij )
        2673             :
        2674             :           ! ----------------------------------------------------------- !
        2675             :           ! Calculate updraft vertical velocity at the upper interface. !
        2676             :           ! In order to calculate 'wtw' at the upper interface, we use  !
        2677             :           ! 'wtw' at the lower interface. Note  'wtw'  is continuously  !
        2678             :           ! updated as cumulus updraft rises.                           !
        2679             :           ! ----------------------------------------------------------- !
        2680             :
        2681           0 :           bogbot = rbuoy * ( thvu(km1) / thvebot  - 1._r8 ) ! Cloud buoyancy at base interface
        2682           0 :           bogtop = rbuoy * ( thvu(k) / thv0top(k) - 1._r8 ) ! Cloud buoyancy at top  interface
        2683             :
        2684           0 :           delbog = bogtop - bogbot
        2685           0 :           drage  = fer(k) * ( 1._r8 + rdrag )
        2686           0 :           expfac = exp(-2._r8*drage*dpe)
        2687             :
        2688           0 :           wtwb = wtw
        2689           0 :           if( drage*dpe .gt. 1.e-3_r8 ) then
        2690           0 :               wtw = wtw*expfac + (delbog + (1._r8-expfac)*(bogbot + delbog/(-2._r8*drage*dpe)))/(rho0j*drage)
        2691             :           else
        2692           0 :               wtw = wtw + dpe * ( bogbot + bogtop ) / rho0j
        2693             :           endif
        2694             :
        2695             :         ! Force the plume rise at least to klfc of the undiluted plume.
        2696             :         ! Because even the below is not complete, I decided not to include this.
        2697             :
        2698             :         ! if( k .le. klfc ) then
        2699             :         !     wtw = max( 1.e-2_r8, wtw )
        2700             :         ! endif
        2701             :
        2702             :           ! -------------------------------------------------------------- !
        2703             :           ! Repeat 'iter_xc' iteration loop until 'iter_xc = niter_xc'.    !
        2704             :           ! Also treat the case even when wtw < 0 at the 'kpen' interface. !
        2705             :           ! -------------------------------------------------------------- !
        2706             :
        2707           0 :           if( wtw .gt. 0._r8 ) then
        2708           0 :               thlue = 0.5_r8 * ( thlu(km1) + thlu(k) )
        2709           0 :               qtue  = 0.5_r8 * ( qtu(km1)  +  qtu(k) )
        2710           0 :               wue   = 0.5_r8 *   sqrt( max( wtwb + wtw, 0._r8 ) )
        2711             :           else
        2712             :               go to 111
        2713             :           endif
        2714             :
        2715             :        enddo ! End of 'iter_xc' loop
        2716             :
        2717             :    111 continue
        2718             :
        2719             :           ! --------------------------------------------------------------------------- !
        2720             :           ! Add the contribution of self-detrainment  to vertical variations of cumulus !
        2721             :           ! updraft mass flux. The reason why we are trying to include self-detrainment !
        2722             :           ! is as follows.  In current scheme,  vertical variation of updraft mass flux !
        2723             :           ! is not fully consistent with the vertical variation of updraft vertical w.  !
        2724             :           ! For example, within a given layer, let's assume that  cumulus w is positive !
        2725             :           ! at the base interface, while negative at the top interface. This means that !
        2726             :           ! cumulus updraft cannot reach to the top interface of the layer. However,    !
        2727             :           ! cumulus updraft mass flux at the top interface is not zero according to the !
        2728             :           ! vertical tendency equation of cumulus mass flux.   Ideally, cumulus updraft !
        2729             :           ! mass flux at the top interface should be zero for this case. In order to    !
        2730             :           ! assures that cumulus updraft mass flux goes to zero when cumulus updraft    !
        2731             :           ! vertical velocity goes to zero, we are imposing self-detrainment term as    !
        2732             :           ! below by considering layer-mean cloud buoyancy and cumulus updraft vertical !
        2733             :           ! velocity square at the top interface. Use of auto-detrainment term will  be !
        2734             :           ! determined by setting 'use_self_detrain=.true.' in the parameter sentence.  !
        2735             :           ! --------------------------------------------------------------------------- !
        2736             :
        2737             :           if( use_self_detrain ) then
        2738             :               autodet = min( 0.5_r8*g*(bogbot+bogtop)/(max(wtw,0._r8)+1.e-4_r8), 0._r8 )
        2739             :               umf(k)  = umf(k) * exp( 0.637_r8*(dpe/rho0j/g) * autodet )
        2740             :           end if
        2741           0 :           if( umf(k) .eq. 0._r8 ) wtw = -1._r8
        2742             :
        2743             :           ! -------------------------------------- !
        2744             :           ! Below block is just a dignostic output !
        2745             :           ! -------------------------------------- !
        2746             :
        2747           0 :           excessu_arr(k) = excessu
        2748           0 :           excess0_arr(k) = excess0
        2749           0 :           xc_arr(k)      = xc
        2750           0 :           aquad_arr(k)   = aquad
        2751           0 :           bquad_arr(k)   = bquad
        2752           0 :           cquad_arr(K)   = cquad
        2753           0 :           bogbot_arr(k)  = bogbot
        2754           0 :           bogtop_arr(k)  = bogtop
        2755             :
        2756             :           ! ------------------------------------------------------------------- !
        2757             :           ! 'kbup' is the upper most layer in which cloud buoyancy  is positive !
        2758             :           ! both at the base and top interface.  'kpen' is the upper most layer !
        2759             :           ! up to cumulus can reach. Usually, 'kpen' is located higher than the !
        2760             :           ! 'kbup'. Note we initialized these by 'kbup = krel' & 'kpen = krel'. !
        2761             :           ! As explained before, it is possible that only 'kpen' is updated,    !
        2762             :           ! while 'kbup' keeps its initialization value. For this case, current !
        2763             :           ! scheme will simply turns-off penetrative entrainment fluxes and use !
        2764             :           ! normal buoyancy-sorting fluxes for 'kbup <= k <= kpen-1' interfaces,!
        2765             :           ! in order to describe shallow continental cumulus convection.        !
        2766             :           ! ------------------------------------------------------------------- !
        2767             :
        2768             :         ! if( bogbot .gt. 0._r8 .and. bogtop .gt. 0._r8 ) then
        2769             :         ! if( bogtop .gt. 0._r8 ) then
        2770           0 :           if( bogtop .gt. 0._r8 .and. wtw .gt. 0._r8 ) then
        2771           0 :               kbup = k
        2772             :           end if
        2773             :
        2774           0 :           if( wtw .le. 0._r8 ) then
        2775             :               kpen = k
        2776             :               go to 45
        2777             :           end if
        2778             :
        2779           0 :           wu(k) = sqrt(wtw)
        2780           0 :           if( wu(k) .gt. 100._r8 ) then
        2781           0 :               exit_wu(i) = 1._r8
        2782           0 :               id_exit = .true.
        2783           0 :               go to 333
        2784             :           endif
        2785             :
        2786             :           ! ---------------------------------------------------------------------------- !
        2787             :           ! Iteration end due to 'rmaxfrac' constraint [ ***************************** ] !
        2788             :           ! ---------------------------------------------------------------------------- !
        2789             :
        2790             :           ! ---------------------------------------------------------------------- !
        2791             :           ! Calculate updraft fractional area at the upper interface and set upper !
        2792             :           ! limit to 'ufrc' by 'rmaxfrac'. In order to keep the consistency  among !
        2793             :           ! ['ufrc','umf','wu (or wtw)'], if ufrc is limited by 'rmaxfrac', either !
        2794             :           ! 'umf' or 'wu' should be changed. Although both 'umf' and 'wu (wtw)' at !
        2795             :           ! the current upper interface are used for updating 'umf' & 'wu'  at the !
        2796             :           ! next upper interface, 'umf' is a passive variable not influencing  the !
        2797             :           ! buoyancy sorting process in contrast to 'wtw'. This is a reason why we !
        2798             :           ! adjusted 'umf' instead of 'wtw'. In turn we updated 'fdr' here instead !
        2799             :           ! of 'fer',  which guarantees  that all previously updated thermodynamic !
        2800             :           ! variables at the upper interface before applying 'rmaxfrac' constraint !
        2801             :           ! are already internally consistent,  even though 'ufrc'  is  limited by !
        2802             :           ! 'rmaxfrac'. Thus, we don't need to go through interation loop again.If !
        2803             :           ! If we update 'fer' however, we should go through above iteration loop. !
        2804             :           ! ---------------------------------------------------------------------- !
        2805             :
        2806           0 :           rhos0j  = ps0(k) / ( r * 0.5_r8 * ( thv0bot(k+1) + thv0top(k) ) * exns0(k) )
        2807           0 :           ufrc(k) = umf(k) / ( rhos0j * wu(k) )
        2808           0 :           if( ufrc(k) .gt. rmaxfrac ) then
        2809           0 :               limit_ufrc(i) = 1._r8
        2810           0 :               ufrc(k) = rmaxfrac
        2811           0 :               umf(k)  = rmaxfrac * rhos0j * wu(k)
        2812           0 :               fdr(k)  = fer(k) - log( umf(k) / umf(km1) ) / dpe
        2813             :           endif
        2814             :
        2815             :           ! ------------------------------------------------------------ !
        2816             :           ! Update environmental properties for at the mid-point of next !
        2817             :           ! upper layer for use in buoyancy sorting.                     !
        2818             :           ! ------------------------------------------------------------ !
        2819             :
        2820           0 :           pe      = p0(k+1)
        2821           0 :           dpe     = dp0(k+1)
        2822           0 :           exne    = exn0(k+1)
        2823           0 :           thvebot = thv0bot(k+1)
        2824           0 :           thle    = thl0(k+1)
        2825           0 :           qte     = qt0(k+1)
        2826           0 :           ue      = u0(k+1)
        2827           0 :           ve      = v0(k+1)
        2828           0 :           do m = 1, ncnst
        2829           0 :              tre(m)  = tr0(k+1,m)
        2830             :           enddo
        2831             :
        2832             :        end do   ! End of cumulus updraft loop from the 'krel' layer to 'kpen' layer.
        2833             :
        2834             :        ! ------------------------------------------------------------------------------- !
        2835             :        ! Up to this point, we finished all of buoyancy sorting processes from the 'krel' !
        2836             :        ! layer to 'kpen' layer: at the top interface of individual layers, we calculated !
        2837             :        ! updraft and penetrative mass fluxes [ umf(k) & emf(k) = 0 ], updraft fractional !
        2838             :        ! area [ ufrc(k) ],  updraft vertical velocity [ wu(k) ],  updraft  thermodynamic !
        2839             :        ! variables [thlu(k),qtu(k),uu(k),vu(k),thvu(k)]. In the layer,we also calculated !
        2840             :        ! fractional entrainment-detrainment rate [ fer(k), fdr(k) ], and detrainment ten !
        2841             :        ! dency of water and ice from cumulus updraft [ dwten(k), diten(k) ]. In addition,!
        2842             :        ! we updated and identified 'krel' and 'kpen' layer index, if any.  In the 'kpen' !
        2843             :        ! layer, we calculated everything mentioned above except the 'wu(k)' and 'ufrc(k)'!
        2844             :        ! since a real value of updraft vertical velocity is not defined at the kpen  top !
        2845             :        ! interface (note 'ufrc' at the top interface of layer is calculated from 'umf(k)'!
        2846             :        ! and 'wu(k)'). As mentioned before, special treatment is required when 'kbup' is !
        2847             :        ! not updated and so 'kbup = krel'.                                               !
        2848             :        ! ------------------------------------------------------------------------------- !
        2849             :
        2850             :        ! ------------------------------------------------------------------------------ !
        2851             :        ! During the 'iter_scaleh' iteration loop, non-physical ( with non-zero values ) !
        2852             :        ! values can remain in the variable arrays above (also 'including' in case of wu !
        2853             :        ! and ufrc at the top interface) the 'kpen' layer. This can happen when the kpen !
        2854             :        ! layer index identified from the 'iter_scaleh = 1' iteration loop is located at !
        2855             :        ! above the kpen layer index identified from   'iter_scaleh = 3' iteration loop. !
        2856             :        ! Thus, in the following calculations, we should only use the values in each     !
        2857             :        ! variables only up to finally identified 'kpen' layer & 'kpen' interface except !
        2858             :        ! 'wu' and 'ufrc' at the top interface of 'kpen' layer.    Note that in order to !
        2859             :        ! prevent any problems due to these non-physical values, I re-initialized    the !
        2860             :        ! values of [ umf(kpen:mkx), emf(kpen:mkx), dwten(kpen+1:mkx), diten(kpen+1:mkx),!
        2861             :        ! fer(kpen:mkx), fdr(kpen+1:mkx), ufrc(kpen:mkx) ] to be zero after 'iter_scaleh'!
        2862             :        ! do loop.                                                                       !
        2863             :        ! ------------------------------------------------------------------------------ !
        2864             :
        2865             :  45    continue
        2866             :
        2867             :        ! ------------------------------------------------------------------------------ !
        2868             :        ! Calculate 'ppen( < 0 )', updarft penetrative distance from the lower interface !
        2869             :        ! of 'kpen' layer. Note that bogbot & bogtop at the 'kpen' layer either when fer !
        2870             :        ! is zero or non-zero was already calculated above.                              !
        2871             :        ! It seems that below qudarature solving formula is valid only when bogbot < 0.  !
        2872             :        ! Below solving equation is clearly wrong ! I should revise this !               !
        2873             :        ! ------------------------------------------------------------------------------ !
        2874             :
        2875           0 :        if( drage .eq. 0._r8 ) then
        2876           0 :            aquad =  ( bogtop - bogbot ) / ( ps0(kpen) - ps0(kpen-1) )
        2877           0 :            bquad =  2._r8 * bogbot
        2878           0 :            cquad = -wu(kpen-1)**2 * rho0j
        2879           0 :            call roots(aquad,bquad,cquad,xc1,xc2,status)
        2880           0 :            if( status .eq. 0 ) then
        2881           0 :                if( xc1 .le. 0._r8 .and. xc2 .le. 0._r8 ) then
        2882           0 :                    ppen = max( xc1, xc2 )
        2883           0 :                    ppen = min( 0._r8,max( -dp0(kpen), ppen ) )
        2884           0 :                elseif( xc1 .gt. 0._r8 .and. xc2 .gt. 0._r8 ) then
        2885           0 :                    ppen = -dp0(kpen)
        2886           0 :                    write(iulog,*) 'Warning : UW-Cumulus penetrates upto kpen interface'
        2887             :                else
        2888           0 :                    ppen = min( xc1, xc2 )
        2889           0 :                    ppen = min( 0._r8,max( -dp0(kpen), ppen ) )
        2890             :                endif
        2891             :            else
        2892           0 :                ppen = -dp0(kpen)
        2893           0 :                write(iulog,*) 'Warning : UW-Cumulus penetrates upto kpen interface'
        2894             :            endif
        2895             :        else
        2896           0 :            ppen = compute_ppen(wtwb,drage,bogbot,bogtop,rho0j,dp0(kpen))
        2897             :        endif
        2898           0 :        if( ppen .eq. -dp0(kpen) .or. ppen .eq. 0._r8 ) limit_ppen(i) = 1._r8
        2899             :
        2900             :        ! -------------------------------------------------------------------- !
        2901             :        ! Re-calculate the amount of expelled condensate from cloud updraft    !
        2902             :        ! at the cumulus top. This is necessary for refined calculations of    !
        2903             :        ! bulk cloud microphysics at the cumulus top. Note that ppen < 0._r8   !
        2904             :        ! In the below, I explicitly calculate 'thlu_top' & 'qtu_top' by       !
        2905             :        ! using non-zero 'fer(kpen)'.                                          !
        2906             :        ! -------------------------------------------------------------------- !
        2907             :
        2908           0 :        if( fer(kpen)*(-ppen) .lt. 1.e-4_r8 ) then
        2909           0 :            thlu_top = thlu(kpen-1) + ( thl0(kpen) + ssthl0(kpen) * (-ppen) / 2._r8 - thlu(kpen-1) ) * fer(kpen) * (-ppen)
        2910           0 :            qtu_top  =  qtu(kpen-1) + (  qt0(kpen) +  ssqt0(kpen) * (-ppen) / 2._r8  - qtu(kpen-1) ) * fer(kpen) * (-ppen)
        2911             :        else
        2912             :            thlu_top = ( thl0(kpen) + ssthl0(kpen) / fer(kpen) - ssthl0(kpen) * (-ppen) / 2._r8 ) - &
        2913           0 :                       ( thl0(kpen) + ssthl0(kpen) * (-ppen) / 2._r8 - thlu(kpen-1) + ssthl0(kpen) / fer(kpen) ) &
        2914           0 :                       * exp(-fer(kpen) * (-ppen))
        2915             :            qtu_top  = ( qt0(kpen)  +  ssqt0(kpen) / fer(kpen) -  ssqt0(kpen) * (-ppen) / 2._r8 ) - &
        2916             :                       ( qt0(kpen)  +  ssqt0(kpen) * (-ppen) / 2._r8 -  qtu(kpen-1) +  ssqt0(kpen) / fer(kpen) ) &
        2917           0 :                       * exp(-fer(kpen) * (-ppen))
        2918             :        end if
        2919             :
        2920           0 :        call conden(ps0(kpen-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check)
        2921           0 :        if( id_check .eq. 1 ) then
        2922           0 :            exit_conden(i) = 1._r8
        2923           0 :            id_exit = .true.
        2924           0 :            go to 333
        2925             :        end if
        2926           0 :        exntop = ((ps0(kpen-1)+ppen)/p00)**rovcp
        2927           0 :        if( (qlj + qij) .gt. criqc ) then
        2928           0 :             dwten(kpen) = ( ( qlj + qij ) - criqc ) * qlj / ( qlj + qij )
        2929           0 :             diten(kpen) = ( ( qlj + qij ) - criqc ) * qij / ( qlj + qij )
        2930           0 :             qtu_top  = qtu_top - dwten(kpen) - diten(kpen)
        2931           0 :             thlu_top = thlu_top + (xlv/cp/exntop)*dwten(kpen) + (xls/cp/exntop)*diten(kpen)
        2932             :        else
        2933           0 :             dwten(kpen) = 0._r8
        2934           0 :             diten(kpen) = 0._r8
        2935             :        endif
        2936             :
        2937             :        ! ----------------------------------------------------------------------- !
        2938             :        ! Calculate cumulus scale height as the top height that cumulus can reach.!
        2939             :        ! ----------------------------------------------------------------------- !
        2940             :
        2941           0 :        rhos0j = ps0(kpen-1)/(r*0.5_r8*(thv0bot(kpen)+thv0top(kpen-1))*exns0(kpen-1))
        2942           0 :        cush   = zs0(kpen-1) - ppen/rhos0j/g
        2943           0 :        scaleh = cush
        2944             :
        2945             :     end do   ! End of 'iter_scaleh' loop.
        2946             :
        2947             :        ! -------------------------------------------------------------------- !
        2948             :        ! The 'forcedCu' is logical identifier saying whether cumulus updraft  !
        2949             :        ! overcome the buoyancy barrier just above the PBL top. If it is true, !
        2950             :        ! cumulus did not overcome the barrier -  this is a shallow convection !
        2951             :        ! with negative cloud buoyancy, mimicking  shallow continental cumulus !
        2952             :        ! convection. Depending on 'forcedCu' parameter, treatment of heat  &  !
        2953             :        ! moisture fluxes at the entraining interfaces, 'kbup <= k < kpen - 1' !
        2954             :        ! will be set up in a different ways, as will be shown later.          !
        2955             :        ! -------------------------------------------------------------------- !
        2956             :
        2957           0 :        if( kbup .eq. krel ) then
        2958           0 :            forcedCu = .true.
        2959           0 :            limit_shcu(i) = 1._r8
        2960             :        else
        2961           0 :            forcedCu = .false.
        2962           0 :            limit_shcu(i) = 0._r8
        2963             :        endif
        2964             :
        2965             :        ! ------------------------------------------------------------------ !
        2966             :        ! Filtering of unerasonable cumulus adjustment here.  This is a very !
        2967             :        ! important process which should be done cautiously. Various ways of !
        2968             :        ! filtering are possible depending on cases mainly using the indices !
        2969             :        ! of key layers - 'klcl','kinv','krel','klfc','kbup','kpen'. At this !
        2970             :        ! stage, the followings are all possible : 'kinv >= 2', 'klcl >= 1', !
        2971             :        ! 'krel >= kinv', 'kbup >= krel', 'kpen >= krel'. I must design this !
        2972             :        ! filtering very cautiously, in such that none of  realistic cumulus !
        2973             :        ! convection is arbitrarily turned-off. Potentially, I might turn-off!
        2974             :        ! cumulus convection if layer-mean 'ql > 0' in the 'kinv-1' layer,in !
        2975             :        ! order to suppress cumulus convection growing, based at the Sc top. !
        2976             :        ! This is one of potential future modifications. Note that ppen < 0. !
        2977             :        ! ------------------------------------------------------------------ !
        2978             :
        2979           0 :        cldhgt = ps0(kpen-1) + ppen
        2980           0 :        if( forcedCu ) then
        2981             :            ! write(iulog,*) 'forcedCu - did not overcome initial buoyancy barrier'
        2982           0 :            exit_cufilter(i) = 1._r8
        2983           0 :            id_exit = .true.
        2984           0 :            go to 333
        2985             :        end if
        2986             :        ! Limit 'additional shallow cumulus' for DYCOMS simulation.
        2987             :        ! if( cldhgt.ge.88000._r8 ) then
        2988             :        !     id_exit = .true.
        2989             :        !     go to 333
        2990             :        ! end if
        2991             :
        2992             :        ! ------------------------------------------------------------------------------ !
        2993             :        ! Re-initializing some key variables above the 'kpen' layer in order to suppress !
        2994             :        ! the influence of non-physical values above 'kpen', in association with the use !
        2995             :        ! of 'iter_scaleh' loop. Note that umf, emf,  ufrc are defined at the interfaces !
        2996             :        ! (0:mkx), while 'dwten','diten', 'fer', 'fdr' are defined at layer mid-points.  !
        2997             :        ! Initialization of 'fer' and 'fdr' is for correct writing purpose of diagnostic !
        2998             :        ! output. Note that we set umf(kpen)=emf(kpen)=ufrc(kpen)=0, in consistent  with !
        2999             :        ! wtw < 0  at the top interface of 'kpen' layer. However, we still have non-zero !
        3000             :        ! expelled cloud condensate in the 'kpen' layer.                                 !
        3001             :        ! ------------------------------------------------------------------------------ !
        3002             :
        3003           0 :        umf(kpen:mkx)     = 0._r8
        3004           0 :        emf(kpen:mkx)     = 0._r8
        3005           0 :        ufrc(kpen:mkx)    = 0._r8
        3006           0 :        dwten(kpen+1:mkx) = 0._r8
        3007           0 :        diten(kpen+1:mkx) = 0._r8
        3008           0 :        fer(kpen+1:mkx)   = 0._r8
        3009           0 :        fdr(kpen+1:mkx)   = 0._r8
        3010             :
        3011             :        ! ------------------------------------------------------------------------ !
        3012             :        ! Calculate downward penetrative entrainment mass flux, 'emf(k) < 0',  and !
        3013             :        ! thermodynamic properties of penetratively entrained airs at   entraining !
        3014             :        ! interfaces. emf(k) is defined from the top interface of the  layer  kbup !
        3015             :        ! to the bottom interface of the layer 'kpen'. Note even when  kbup = krel,!
        3016             :        ! i.e.,even when 'kbup' was not updated in the above buoyancy  sorting  do !
        3017             :        ! loop (i.e., 'kbup' remains as the initialization value),   below do loop !
        3018             :        ! of penetrative entrainment flux can be performed without  any conceptual !
        3019             :        ! or logical problems, because we have already computed all  the variables !
        3020             :        ! necessary for performing below penetrative entrainment block.            !
        3021             :        ! In the below 'do' loop, 'k' is an interface index at which non-zero 'emf'!
        3022             :        ! (penetrative entrainment mass flux) is calculated. Since cumulus updraft !
        3023             :        ! is negatively buoyant in the layers between the top interface of 'kbup'  !
        3024             :        ! layer (interface index, kbup) and the top interface of 'kpen' layer, the !
        3025             :        ! fractional lateral entrainment, fer(k) within these layers will be close !
        3026             :        ! to zero - so it is likely that only strong lateral detrainment occurs in !
        3027             :        ! thses layers. Under this situation,we can easily calculate the amount of !
        3028             :        ! detrainment cumulus air into these negatively buoyanct layers by  simply !
        3029             :        ! comparing cumulus updraft mass fluxes between the base and top interface !
        3030             :        ! of each layer: emf(k) = emf(k-1)*exp(-fdr(k)*dp0(k))                     !
        3031             :        !                       ~ emf(k-1)*(1-rei(k)*dp0(k))                       !
        3032             :        !                emf(k-1)-emf(k) ~ emf(k-1)*rei(k)*dp0(k)                  !
        3033             :        ! Current code assumes that about 'rpen~10' times of these detrained  mass !
        3034             :        ! are penetratively re-entrained down into the 'k-1' interface. And all of !
        3035             :        ! these detrained masses are finally dumped down into the top interface of !
        3036             :        ! 'kbup' layer. Thus, the amount of penetratively entrained air across the !
        3037             :        ! top interface of 'kbup' layer with 'rpen~10' becomes too large.          !
        3038             :        ! Note that this penetrative entrainment part can be completely turned-off !
        3039             :        ! and we can simply use normal buoyancy-sorting involved turbulent  fluxes !
        3040             :        ! by modifying 'penetrative entrainment fluxes' part below.                !
        3041             :        ! ------------------------------------------------------------------------ !
        3042             :
        3043             :        ! -----------------------------------------------------------------------!
        3044             :        ! Calculate entrainment mass flux and conservative scalars of entraining !
        3045             :        ! free air at interfaces of 'kbup <= k < kpen - 1'                       !
        3046             :        ! ---------------------------------------------------------------------- !
        3047             :
        3048           0 :        do k = 0, mkx
        3049           0 :           thlu_emf(k) = thlu(k)
        3050           0 :           qtu_emf(k)  = qtu(k)
        3051           0 :           uu_emf(k)   = uu(k)
        3052           0 :           vu_emf(k)   = vu(k)
        3053           0 :           do m = 1, ncnst
        3054           0 :              tru_emf(k,m)  = tru(k,m)
        3055             :           enddo
        3056             :        end do
        3057             :
        3058           0 :        do k = kpen - 1, kbup, -1  ! Here, 'k' is an interface index at which
        3059             :                                   ! penetrative entrainment fluxes are calculated.
        3060             :
        3061           0 :           rhos0j = ps0(k) / ( r * 0.5_r8 * ( thv0bot(k+1) + thv0top(k) ) * exns0(k) )
        3062             :
        3063           0 :           if( k .eq. kpen - 1 ) then
        3064             :
        3065             :              ! ------------------------------------------------------------------------ !
        3066             :              ! Note that 'ppen' has already been calculated in the above 'iter_scaleh'  !
        3067             :              ! loop assuming zero lateral entrainmentin the layer 'kpen'.               !
        3068             :              ! ------------------------------------------------------------------------ !
        3069             :
        3070             :              ! -------------------------------------------------------------------- !
        3071             :              ! Calculate returning mass flux, emf ( < 0 )                           !
        3072             :              ! Current penetrative entrainment rate with 'rpen~10' is too large and !
        3073             :              ! future refinement is necessary including the definition of 'thl','qt'!
        3074             :              ! of penetratively entrained air.  Penetratively entrained airs across !
        3075             :              ! the 'kpen-1' interface is assumed to have the properties of the base !
        3076             :              ! interface of 'kpen' layer. Note that 'emf ~ - umf/ufrc = - w * rho'. !
        3077             :              ! Thus, below limit sets an upper limit of |emf| to be ~ 10cm/s, which !
        3078             :              ! is very loose constraint. Here, I used more restricted constraint on !
        3079             :              ! the limit of emf, assuming 'emf' cannot exceed a net mass within the !
        3080             :              ! layer above the interface. Similar to the case of warming and drying !
        3081             :              ! due to cumulus updraft induced compensating subsidence,  penetrative !
        3082             :              ! entrainment induces compensating upwelling -     in order to prevent !
        3083             :              ! numerical instability in association with compensating upwelling, we !
        3084             :              ! should similarily limit the amount of penetrative entrainment at the !
        3085             :              ! interface by the amount of masses within the layer just above the    !
        3086             :              ! penetratively entraining interface.                                  !
        3087             :              ! -------------------------------------------------------------------- !
        3088             :
        3089           0 :              if( ( umf(k)*ppen*rei(kpen)*rpen ) .lt. -0.1_r8*rhos0j )         limit_emf(i) = 1._r8
        3090           0 :              if( ( umf(k)*ppen*rei(kpen)*rpen ) .lt. -0.9_r8*dp0(kpen)/g/dt ) limit_emf(i) = 1._r8
        3091             :
        3092           0 :              emf(k) = max( max( umf(k)*ppen*rei(kpen)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(kpen)/g/dt)
        3093           0 :              thlu_emf(k) = thl0(kpen) + ssthl0(kpen) * ( ps0(k) - p0(kpen) )
        3094           0 :              qtu_emf(k)  = qt0(kpen)  + ssqt0(kpen)  * ( ps0(k) - p0(kpen) )
        3095           0 :              uu_emf(k)   = u0(kpen)   + ssu0(kpen)   * ( ps0(k) - p0(kpen) )
        3096           0 :              vu_emf(k)   = v0(kpen)   + ssv0(kpen)   * ( ps0(k) - p0(kpen) )
        3097           0 :              do m = 1, ncnst
        3098           0 :                 tru_emf(k,m)  = tr0(kpen,m)  + sstr0(kpen,m)  * ( ps0(k) - p0(kpen) )
        3099             :              enddo
        3100             :
        3101             :           else ! if(k.lt.kpen-1).
        3102             :
        3103             :              ! --------------------------------------------------------------------------- !
        3104             :              ! Note we are coming down from the higher interfaces to the lower interfaces. !
        3105             :              ! Also note that 'emf < 0'. So, below operation is a summing not subtracting. !
        3106             :              ! In order to ensure numerical stability, I imposed a modified correct limit  !
        3107             :              ! of '-0.9*dp0(k+1)/g/dt' on emf(k).                                          !
        3108             :              ! --------------------------------------------------------------------------- !
        3109             :
        3110             :              if( use_cumpenent ) then  ! Original Cumulative Penetrative Entrainment
        3111             :
        3112           0 :                  if( ( emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.1_r8*rhos0j )        limit_emf(i) = 1
        3113           0 :                  if( ( emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.9_r8*dp0(k+1)/g/dt ) limit_emf(i) = 1
        3114           0 :                  emf(k) = max(max(emf(k+1)-umf(k)*dp0(k+1)*rei(k+1)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(k+1)/g/dt )
        3115           0 :                  if( abs(emf(k)) .gt. abs(emf(k+1)) ) then
        3116           0 :                      thlu_emf(k) = ( thlu_emf(k+1) * emf(k+1) + thl0(k+1) * ( emf(k) - emf(k+1) ) ) / emf(k)
        3117           0 :                      qtu_emf(k)  = ( qtu_emf(k+1)  * emf(k+1) + qt0(k+1)  * ( emf(k) - emf(k+1) ) ) / emf(k)
        3118           0 :                      uu_emf(k)   = ( uu_emf(k+1)   * emf(k+1) + u0(k+1)   * ( emf(k) - emf(k+1) ) ) / emf(k)
        3119           0 :                      vu_emf(k)   = ( vu_emf(k+1)   * emf(k+1) + v0(k+1)   * ( emf(k) - emf(k+1) ) ) / emf(k)
        3120           0 :                      do m = 1, ncnst
        3121           0 :                         tru_emf(k,m)  = ( tru_emf(k+1,m)  * emf(k+1) + tr0(k+1,m)  * ( emf(k) - emf(k+1) ) ) / emf(k)
        3122             :                      enddo
        3123             :                  else
        3124           0 :                      thlu_emf(k) = thl0(k+1)
        3125           0 :                      qtu_emf(k)  =  qt0(k+1)
        3126           0 :                      uu_emf(k)   =   u0(k+1)
        3127           0 :                      vu_emf(k)   =   v0(k+1)
        3128           0 :                      do m = 1, ncnst
        3129           0 :                         tru_emf(k,m)  =  tr0(k+1,m)
        3130             :                      enddo
        3131             :                  endif
        3132             :
        3133             :              else ! Alternative Non-Cumulative Penetrative Entrainment
        3134             :
        3135             :                  if( ( -umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.1_r8*rhos0j )        limit_emf(i) = 1
        3136             :                  if( ( -umf(k)*dp0(k+1)*rei(k+1)*rpen ) .lt. -0.9_r8*dp0(k+1)/g/dt ) limit_emf(i) = 1
        3137             :                  emf(k) = max(max(-umf(k)*dp0(k+1)*rei(k+1)*rpen, -0.1_r8*rhos0j), -0.9_r8*dp0(k+1)/g/dt )
        3138             :                  thlu_emf(k) = thl0(k+1)
        3139             :                  qtu_emf(k)  =  qt0(k+1)
        3140             :                  uu_emf(k)   =   u0(k+1)
        3141             :                  vu_emf(k)   =   v0(k+1)
        3142             :                  do m = 1, ncnst
        3143             :                     tru_emf(k,m)  =  tr0(k+1,m)
        3144             :                  enddo
        3145             :
        3146             :              endif
        3147             :
        3148             :           endif
        3149             :
        3150             :           ! ---------------------------------------------------------------------------- !
        3151             :           ! In this GCM modeling framework,  all what we should do is to calculate  heat !
        3152             :           ! and moisture fluxes at the given geometrically-fixed height interfaces -  we !
        3153             :           ! don't need to worry about movement of material height surface in association !
        3154             :           ! with compensating subsidence or unwelling, in contrast to the bulk modeling. !
        3155             :           ! In this geometrically fixed height coordinate system, heat and moisture flux !
        3156             :           ! at the geometrically fixed height handle everything - a movement of material !
        3157             :           ! surface is implicitly treated automatically. Note that in terms of turbulent !
        3158             :           ! heat and moisture fluxes at model interfaces, both the cumulus updraft  mass !
        3159             :           ! flux and penetratively entraining mass flux play the same role -both of them !
        3160             :           ! warms and dries the 'kbup' layer, cools and moistens the 'kpen' layer,   and !
        3161             :           ! cools and moistens any intervening layers between 'kbup' and 'kpen' layers.  !
        3162             :           ! It is important to note these identical roles on turbulent heat and moisture !
        3163             :           ! fluxes of 'umf' and 'emf'.                                                   !
        3164             :           ! When 'kbup' is a stratocumulus-topped PBL top interface,  increase of 'rpen' !
        3165             :           ! is likely to strongly diffuse stratocumulus top interface,  resulting in the !
        3166             :           ! reduction of cloud fraction. In this sense, the 'kbup' interface has a  very !
        3167             :           ! important meaning and role : across the 'kbup' interface, strong penetrative !
        3168             :           ! entrainment occurs, thus any sharp gradient properties across that interface !
        3169             :           ! are easily diffused through strong mass exchange. Thus, an initialization of !
        3170             :           ! 'kbup' (and also 'kpen') should be done very cautiously as mentioned before. !
        3171             :           ! In order to prevent this stron diffusion for the shallow cumulus convection  !
        3172             :           ! based at the Sc top, it seems to be good to initialize 'kbup = krel', rather !
        3173             :           ! that 'kbup = krel-1'.                                                        !
        3174             :           ! ---------------------------------------------------------------------------- !
        3175             :
        3176             :        end do
        3177             :
        3178             :        !------------------------------------------------------------------ !
        3179             :        !                                                                   !
        3180             :        ! Compute turbulent heat, moisture, momentum flux at all interfaces !
        3181             :        !                                                                   !
        3182             :        !------------------------------------------------------------------ !
        3183             :        ! It is very important to note that in calculating turbulent fluxes !
        3184             :        ! below, we must not double count turbulent flux at any interefaces.!
        3185             :        ! In the below, turbulent fluxes at the interfaces (interface index !
        3186             :        ! k) are calculated by the following 4 blocks in consecutive order: !
        3187             :        !                                                                   !
        3188             :        ! (1) " 0 <= k <= kinv - 1 "  : PBL fluxes.                         !
        3189             :        !     From 'fluxbelowinv' using reconstructed PBL height. Currently,!
        3190             :        !     the reconstructed PBLs are independently calculated for  each !
        3191             :        !     individual conservative scalar variables ( qt, thl, u, v ) in !
        3192             :        !     each 'fluxbelowinv',  instead of being uniquely calculated by !
        3193             :        !     using thvl. Turbulent flux at the surface is assumed to be 0. !
        3194             :        ! (2) " kinv <= k <= krel - 1 " : Non-buoyancy sorting fluxes       !
        3195             :        !     Assuming cumulus mass flux  and cumulus updraft thermodynamic !
        3196             :        !     properties (except u, v which are modified by the PGFc during !
        3197             :        !     upward motion) are conserved during a updraft motion from the !
        3198             :        !     PBL top interface to the release level. If these layers don't !
        3199             :        !     exist (e,g, when 'krel = kinv'), then  current routine do not !
        3200             :        !     perform this routine automatically. So I don't need to modify !
        3201             :        !     anything.                                                     !
        3202             :        ! (3) " krel <= k <= kbup - 1 " : Buoyancy sorting fluxes           !
        3203             :        !     From laterally entraining-detraining buoyancy sorting plumes. !
        3204             :        ! (4) " kbup <= k < kpen-1 " : Penetrative entrainment fluxes       !
        3205             :        !     From penetratively entraining plumes,                         !
        3206             :        !                                                                   !
        3207             :        ! In case of normal situation, turbulent interfaces  in each groups !
        3208             :        ! are mutually independent of each other. Thus double flux counting !
        3209             :        ! or ambiguous flux counting requiring the choice among the above 4 !
        3210             :        ! groups do not occur normally. However, in case that cumulus plume !
        3211             :        ! could not completely overcome the buoyancy barrier just above the !
        3212             :        ! PBL top interface and so 'kbup = krel' (.forcedCu=.true.) ( here, !
        3213             :        ! it can be either 'kpen = krel' as the initialization, or ' kpen > !
        3214             :        ! krel' if cumulus updraft just penetrated over the top of  release !
        3215             :        ! layer ). If this happens, we should be very careful in organizing !
        3216             :        ! the sequence of the 4 calculation routines above -  note that the !
        3217             :        ! routine located at the later has the higher priority.  Additional !
        3218             :        ! feature I must consider is that when 'kbup = kinv - 1' (this is a !
        3219             :        ! combined situation of 'kbup=krel-1' & 'krel = kinv' when I  chose !
        3220             :        ! 'kbup=krel-1' instead of current choice of 'kbup=krel'), a strong !
        3221             :        ! penetrative entrainment fluxes exists at the PBL top interface, & !
        3222             :        ! all of these fluxes are concentrated (deposited) within the layer !
        3223             :        ! just below PBL top interface (i.e., 'kinv-1' layer). On the other !
        3224             :        ! hand, in case of 'fluxbelowinv', only the compensating subsidence !
        3225             :        ! effect is concentrated in the 'kinv-1' layer and 'pure' turbulent !
        3226             :        ! heat and moisture fluxes ( 'pure' means the fluxes not associated !
        3227             :        ! with compensating subsidence) are linearly distributed throughout !
        3228             :        ! the whole PBL. Thus different choice of the above flux groups can !
        3229             :        ! produce very different results. Output variable should be written !
        3230             :        ! consistently to the choice of computation sequences.              !
        3231             :        ! When the case of 'kbup = krel(-1)' happens,another way to dealing !
        3232             :        ! with this case is to simply ' exit ' the whole cumulus convection !
        3233             :        ! calculation without performing any cumulus convection.     We can !
        3234             :        ! choose this approach by specifying a condition in the  'Filtering !
        3235             :        ! of unreasonable cumulus adjustment' just after 'iter_scaleh'. But !
        3236             :        ! this seems not to be a good choice (although this choice was used !
        3237             :        ! previous code ), since it might arbitrary damped-out  the shallow !
        3238             :        ! cumulus convection over the continent land, where shallow cumulus !
        3239             :        ! convection tends to be negatively buoyant.                        !
        3240             :        ! ----------------------------------------------------------------- !
        3241             :
        3242             :        ! --------------------------------------------------- !
        3243             :        ! 1. PBL fluxes :  0 <= k <= kinv - 1                 !
        3244             :        !    All the information necessary to reconstruct PBL !
        3245             :        !    height are passed to 'fluxbelowinv'.             !
        3246             :        ! --------------------------------------------------- !
        3247             :
        3248           0 :        xsrc  = qtsrc
        3249           0 :        xmean = qt0(kinv)
        3250           0 :        xtop  = qt0(kinv+1) + ssqt0(kinv+1) * ( ps0(kinv)   - p0(kinv+1) )
        3251           0 :        xbot  = qt0(kinv-1) + ssqt0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        3252           0 :        call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx )
        3253           0 :        qtflx(0:kinv-1) = xflx(0:kinv-1)
        3254             :
        3255           0 :        xsrc  = thlsrc
        3256           0 :        xmean = thl0(kinv)
        3257           0 :        xtop  = thl0(kinv+1) + ssthl0(kinv+1) * ( ps0(kinv)   - p0(kinv+1) )
        3258           0 :        xbot  = thl0(kinv-1) + ssthl0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        3259           0 :        call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx )
        3260           0 :        slflx(0:kinv-1) = cp * exns0(0:kinv-1) * xflx(0:kinv-1)
        3261             :
        3262           0 :        xsrc  = usrc
        3263           0 :        xmean = u0(kinv)
        3264           0 :        xtop  = u0(kinv+1) + ssu0(kinv+1) * ( ps0(kinv)   - p0(kinv+1) )
        3265           0 :        xbot  = u0(kinv-1) + ssu0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        3266           0 :        call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx )
        3267           0 :        uflx(0:kinv-1) = xflx(0:kinv-1)
        3268             :
        3269           0 :        xsrc  = vsrc
        3270           0 :        xmean = v0(kinv)
        3271           0 :        xtop  = v0(kinv+1) + ssv0(kinv+1) * ( ps0(kinv)   - p0(kinv+1) )
        3272           0 :        xbot  = v0(kinv-1) + ssv0(kinv-1) * ( ps0(kinv-1) - p0(kinv-1) )
        3273           0 :        call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx )
        3274           0 :        vflx(0:kinv-1) = xflx(0:kinv-1)
        3275             :
        3276           0 :        do m = 1, ncnst
        3277           0 :           xsrc  = trsrc(m)
        3278           0 :           xmean = tr0(kinv,m)
        3279           0 :           xtop  = tr0(kinv+1,m) + sstr0(kinv+1,m) * ( ps0(kinv)   - p0(kinv+1) )
        3280           0 :           xbot  = tr0(kinv-1,m) + sstr0(kinv-1,m) * ( ps0(kinv-1) - p0(kinv-1) )
        3281           0 :           call fluxbelowinv( cbmf, ps0(0:mkx), mkx, kinv, dt, xsrc, xmean, xtop, xbot, xflx )
        3282           0 :           trflx(0:kinv-1,m) = xflx(0:kinv-1)
        3283             :        enddo
        3284             :
        3285             :        ! -------------------------------------------------------------- !
        3286             :        ! 2. Non-buoyancy sorting fluxes : kinv <= k <= krel - 1         !
        3287             :        !    Note that when 'krel = kinv', below block is never executed !
        3288             :        !    as in a desirable, expected way ( but I must check  if this !
        3289             :        !    is the case ). The non-buoyancy sorting fluxes are computed !
        3290             :        !    only when 'krel > kinv'.                                    !
        3291             :        ! -------------------------------------------------------------- !
        3292             :
        3293           0 :        uplus = 0._r8
        3294           0 :        vplus = 0._r8
        3295           0 :        do k = kinv, krel - 1
        3296           0 :           kp1 = k + 1
        3297           0 :           qtflx(k) = cbmf * ( qtsrc  - (  qt0(kp1) +  ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3298           0 :           slflx(k) = cbmf * ( thlsrc - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) * cp * exns0(k)
        3299           0 :           uplus    = uplus + PGFc * ssu0(k) * ( ps0(k) - ps0(k-1) )
        3300           0 :           vplus    = vplus + PGFc * ssv0(k) * ( ps0(k) - ps0(k-1) )
        3301           0 :           uflx(k)  = cbmf * ( usrc + uplus -  (  u0(kp1)  +   ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3302           0 :           vflx(k)  = cbmf * ( vsrc + vplus -  (  v0(kp1)  +   ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3303           0 :           do m = 1, ncnst
        3304           0 :              trflx(k,m) = cbmf * ( trsrc(m)  - (  tr0(kp1,m) +  sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) )
        3305             :           enddo
        3306             :        end do
        3307             :
        3308             :        ! ------------------------------------------------------------------------ !
        3309             :        ! 3. Buoyancy sorting fluxes : krel <= k <= kbup - 1                       !
        3310             :        !    In case that 'kbup = krel - 1 ' ( or even in case 'kbup = krel' ),    !
        3311             :        !    buoyancy sorting fluxes are not calculated, which is consistent,      !
        3312             :        !    desirable feature.                                                    !
        3313             :        ! ------------------------------------------------------------------------ !
        3314             :
        3315           0 :        do k = krel, kbup - 1
        3316           0 :           kp1 = k + 1
        3317           0 :           slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k) - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3318           0 :           qtflx(k) = umf(k) * ( qtu(k) - ( qt0(kp1) + ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3319           0 :           uflx(k)  = umf(k) * ( uu(k) - ( u0(kp1) + ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3320           0 :           vflx(k)  = umf(k) * ( vu(k) - ( v0(kp1) + ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) )
        3321           0 :           do m = 1, ncnst
        3322           0 :              trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) )
        3323             :           enddo
        3324             :        end do
        3325             :
        3326             :        ! ------------------------------------------------------------------------- !
        3327             :        ! 4. Penetrative entrainment fluxes : kbup <= k <= kpen - 1                 !
        3328             :        !    The only confliction that can happen is when 'kbup = kinv-1'. For this !
        3329             :        !    case, turbulent flux at kinv-1 is calculated  both from 'fluxbelowinv' !
        3330             :        !    and here as penetrative entrainment fluxes.  Since penetrative flux is !
        3331             :        !    calculated later, flux at 'kinv - 1 ' will be that of penetrative flux.!
        3332             :        !    However, turbulent flux calculated at 'kinv - 1' from penetrative entr.!
        3333             :        !    is less attractable,  since more reasonable turbulent flux at 'kinv-1' !
        3334             :        !    should be obtained from 'fluxbelowinv', by considering  re-constructed !
        3335             :        !    inversion base height. This conflicting problem can be solved if we can!
        3336             :        !    initialize 'kbup = krel', instead of kbup = krel - 1. This choice seems!
        3337             :        !    to be more reasonable since it is not conflicted with 'fluxbelowinv' in!
        3338             :        !    calculating fluxes at 'kinv - 1' ( for this case, flux at 'kinv-1' is  !
        3339             :        !    always from 'fluxbelowinv' ), and flux at 'krel-1' is calculated from  !
        3340             :        !    the non-buoyancy sorting flux without being competed with penetrative  !
        3341             :        !    entrainment fluxes. Even when we use normal cumulus flux instead of    !
        3342             :        !    penetrative entrainment fluxes at 'kbup <= k <= kpen-1' interfaces,    !
        3343             :        !    the initialization of kbup=krel perfectly works without any conceptual !
        3344             :        !    confliction. Thus it seems to be much better to choose 'kbup = krel'   !
        3345             :        !    initialization of 'kbup', which is current choice.                     !
        3346             :        !    Note that below formula uses conventional updraft cumulus fluxes for   !
        3347             :        !    shallow cumulus which did not overcome the first buoyancy barrier above!
        3348             :        !    PBL top while uses penetrative entrainment fluxes for the other cases  !
        3349             :        !    'kbup <= k <= kpen-1' interfaces. Depending on cases, however, I can   !
        3350             :        !    selelct different choice.                                              !
        3351             :        ! ------------------------------------------------------------------------------------------------------------------ !
        3352             :        !   if( forcedCu ) then                                                                                              !
        3353             :        !       slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k) - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) )         !
        3354             :        !       qtflx(k) =                 umf(k) * (  qtu(k) - (  qt0(kp1) +  ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) )         !
        3355             :        !       uflx(k)  =                 umf(k) * (   uu(k) - (   u0(kp1) +   ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) )         !
        3356             :        !       vflx(k)  =                 umf(k) * (   vu(k) - (   v0(kp1) +   ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) )         !
        3357             :        !       do m = 1, ncnst                                                                                              !
        3358             :        !          trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) )                 !
        3359             :        !       enddo                                                                                                        !
        3360             :        !   else                                                                                                             !
        3361             :        !       slflx(k) = cp * exns0(k) * emf(k) * ( thlu_emf(k) - ( thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) ) )           !
        3362             :        !       qtflx(k) =                 emf(k) * (  qtu_emf(k) - (  qt0(k) +  ssqt0(k) * ( ps0(k) - p0(k) ) ) )           !
        3363             :        !       uflx(k)  =                 emf(k) * (   uu_emf(k) - (   u0(k) +   ssu0(k) * ( ps0(k) - p0(k) ) ) )           !
        3364             :        !       vflx(k)  =                 emf(k) * (   vu_emf(k) - (   v0(k) +   ssv0(k) * ( ps0(k) - p0(k) ) ) )           !
        3365             :        !       do m = 1, ncnst                                                                                              !
        3366             :        !          trflx(k,m) = emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) )                   !
        3367             :        !       enddo                                                                                                        !
        3368             :        !   endif                                                                                                            !
        3369             :        !                                                                                                                    !
        3370             :        !   if( use_uppenent ) then ! Combined Updraft + Penetrative Entrainment Flux                                        !
        3371             :        !       slflx(k) = cp * exns0(k) * umf(k) * ( thlu(k)     - ( thl0(kp1) + ssthl0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & !
        3372             :        !                  cp * exns0(k) * emf(k) * ( thlu_emf(k) - (   thl0(k) +   ssthl0(k) * ( ps0(k) - p0(k) ) ) )       !
        3373             :        !       qtflx(k) =                 umf(k) * (  qtu(k)     - (  qt0(kp1) +  ssqt0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & !
        3374             :        !                                  emf(k) * (  qtu_emf(k) - (    qt0(k) +    ssqt0(k) * ( ps0(k) - p0(k) ) ) )       !
        3375             :        !       uflx(k)  =                 umf(k) * (   uu(k)     - (   u0(kp1) +   ssu0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & !
        3376             :        !                                  emf(k) * (   uu_emf(k) - (     u0(k) +     ssu0(k) * ( ps0(k) - p0(k) ) ) )       !
        3377             :        !       vflx(k)  =                 umf(k) * (   vu(k)     - (   v0(kp1) +   ssv0(kp1) * ( ps0(k) - p0(kp1) ) ) ) + & !
        3378             :        !                                  emf(k) * (   vu_emf(k) - (     v0(k) +     ssv0(k) * ( ps0(k) - p0(k) ) ) )       !
        3379             :        !       do m = 1, ncnst                                                                                              !
        3380             :        !          trflx(k,m) = umf(k) * ( tru(k,m) - ( tr0(kp1,m) + sstr0(kp1,m) * ( ps0(k) - p0(kp1) ) ) ) + &             !
        3381             :        !                       emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) )                   !
        3382             :        !       enddo                                                                                                        !
        3383             :        ! ------------------------------------------------------------------------------------------------------------------ !
        3384             :
        3385           0 :        do k = kbup, kpen - 1
        3386           0 :           kp1 = k + 1
        3387           0 :           slflx(k) = cp * exns0(k) * emf(k) * ( thlu_emf(k) - ( thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) ) ) )
        3388           0 :           qtflx(k) =                 emf(k) * (  qtu_emf(k) - (  qt0(k) +  ssqt0(k) * ( ps0(k) - p0(k) ) ) )
        3389           0 :           uflx(k)  =                 emf(k) * (   uu_emf(k) - (   u0(k) +   ssu0(k) * ( ps0(k) - p0(k) ) ) )
        3390           0 :           vflx(k)  =                 emf(k) * (   vu_emf(k) - (   v0(k) +   ssv0(k) * ( ps0(k) - p0(k) ) ) )
        3391           0 :           do m = 1, ncnst
        3392           0 :              trflx(k,m) = emf(k) * ( tru_emf(k,m) - ( tr0(k,m) + sstr0(k,m) * ( ps0(k) - p0(k) ) ) )
        3393             :           enddo
        3394             :        end do
        3395             :
        3396             :        ! ------------------------------------------- !
        3397             :        ! Turn-off cumulus momentum flux as an option !
        3398             :        ! ------------------------------------------- !
        3399             :
        3400             :        if( .not. use_momenflx ) then
        3401             :            uflx(0:mkx) = 0._r8
        3402             :            vflx(0:mkx) = 0._r8
        3403             :        endif
        3404             :
        3405             :        ! -------------------------------------------------------- !
        3406             :        ! Condensate tendency by compensating subsidence/upwelling !
        3407             :        ! -------------------------------------------------------- !
        3408             :
        3409           0 :        uemf(0:mkx)         = 0._r8
        3410           0 :        do k = 0, kinv - 2  ! Assume linear updraft mass flux within the PBL.
        3411           0 :           uemf(k) = cbmf * ( ps0(0) - ps0(k) ) / ( ps0(0) - ps0(kinv-1) )
        3412             :        end do
        3413           0 :        uemf(kinv-1:krel-1) = cbmf
        3414           0 :        uemf(krel:kbup-1)   = umf(krel:kbup-1)
        3415           0 :        uemf(kbup:kpen-1)   = emf(kbup:kpen-1) ! Only use penetrative entrainment flux consistently.
        3416             :
        3417           0 :        comsub(1:mkx) = 0._r8
        3418           0 :        do k = 1, kpen
        3419           0 :           comsub(k)  = 0.5_r8 * ( uemf(k) + uemf(k-1) )
        3420             :        end do
        3421             :
        3422           0 :        do k = 1, kpen
        3423           0 :           if( comsub(k) .ge. 0._r8 ) then
        3424           0 :               if( k .eq. mkx ) then
        3425             :                   thlten_sub = 0._r8
        3426             :                   qtten_sub  = 0._r8
        3427             :                   qlten_sub  = 0._r8
        3428             :                   qiten_sub  = 0._r8
        3429             :                   nlten_sub  = 0._r8
        3430             :                   niten_sub  = 0._r8
        3431             :               else
        3432           0 :                   thlten_sub = g * comsub(k) * ( thl0(k+1) - thl0(k) ) / ( p0(k) - p0(k+1) )
        3433           0 :                   qtten_sub  = g * comsub(k) * (  qt0(k+1) -  qt0(k) ) / ( p0(k) - p0(k+1) )
        3434           0 :                   qlten_sub  = g * comsub(k) * (  ql0(k+1) -  ql0(k) ) / ( p0(k) - p0(k+1) )
        3435           0 :                   qiten_sub  = g * comsub(k) * (  qi0(k+1) -  qi0(k) ) / ( p0(k) - p0(k+1) )
        3436           0 :                   nlten_sub  = g * comsub(k) * (  tr0(k+1,ixnumliq) -  tr0(k,ixnumliq) ) / ( p0(k) - p0(k+1) )
        3437           0 :                   niten_sub  = g * comsub(k) * (  tr0(k+1,ixnumice) -  tr0(k,ixnumice) ) / ( p0(k) - p0(k+1) )
        3438             :               endif
        3439             :           else
        3440           0 :               if( k .eq. 1 ) then
        3441             :                   thlten_sub = 0._r8
        3442             :                   qtten_sub  = 0._r8
        3443             :                   qlten_sub  = 0._r8
        3444             :                   qiten_sub  = 0._r8
        3445             :                   nlten_sub  = 0._r8
        3446             :                   niten_sub  = 0._r8
        3447             :               else
        3448           0 :                   thlten_sub = g * comsub(k) * ( thl0(k) - thl0(k-1) ) / ( p0(k-1) - p0(k) )
        3449           0 :                   qtten_sub  = g * comsub(k) * (  qt0(k) -  qt0(k-1) ) / ( p0(k-1) - p0(k) )
        3450           0 :                   qlten_sub  = g * comsub(k) * (  ql0(k) -  ql0(k-1) ) / ( p0(k-1) - p0(k) )
        3451           0 :                   qiten_sub  = g * comsub(k) * (  qi0(k) -  qi0(k-1) ) / ( p0(k-1) - p0(k) )
        3452           0 :                   nlten_sub  = g * comsub(k) * (  tr0(k,ixnumliq) -  tr0(k-1,ixnumliq) ) / ( p0(k-1) - p0(k) )
        3453           0 :                   niten_sub  = g * comsub(k) * (  tr0(k,ixnumice) -  tr0(k-1,ixnumice) ) / ( p0(k-1) - p0(k) )
        3454             :               endif
        3455             :           endif
        3456           0 :           thl_prog = thl0(k) + thlten_sub * dt
        3457           0 :           qt_prog  = max( qt0(k) + qtten_sub * dt, 1.e-12_r8 )
        3458           0 :           call conden(p0(k),thl_prog,qt_prog,thj,qvj,qlj,qij,qse,id_check)
        3459           0 :           if( id_check .eq. 1 ) then
        3460             :               id_exit = .true.
        3461             :               go to 333
        3462             :           endif
        3463             :         ! qlten_sink(k) = ( qlj - ql0(k) ) / dt
        3464             :         ! qiten_sink(k) = ( qij - qi0(k) ) / dt
        3465           0 :           qlten_sink(k) = max( qlten_sub, - ql0(k) / dt ) ! For consistency with prognostic macrophysics scheme
        3466           0 :           qiten_sink(k) = max( qiten_sub, - qi0(k) / dt ) ! For consistency with prognostic macrophysics scheme
        3467           0 :           nlten_sink(k) = max( nlten_sub, - tr0(k,ixnumliq) / dt )
        3468           0 :           niten_sink(k) = max( niten_sub, - tr0(k,ixnumice) / dt )
        3469             :        end do
        3470             :
        3471             :        ! --------------------------------------------- !
        3472             :        !                                               !
        3473             :        ! Calculate convective tendencies at each layer !
        3474             :        !                                               !
        3475             :        ! --------------------------------------------- !
        3476             :
        3477             :        ! ----------------- !
        3478             :        ! Momentum tendency !
        3479             :        ! ----------------- !
        3480             :
        3481           0 :        do k = 1, kpen
        3482           0 :           km1 = k - 1
        3483           0 :           uten(k) = ( uflx(km1) - uflx(k) ) * g / dp0(k)
        3484           0 :           vten(k) = ( vflx(km1) - vflx(k) ) * g / dp0(k)
        3485           0 :           uf(k)   = u0(k) + uten(k) * dt
        3486           0 :           vf(k)   = v0(k) + vten(k) * dt
        3487             :         ! do m = 1, ncnst
        3488             :         !    trten(k,m) = ( trflx(km1,m) - trflx(k,m) ) * g / dp0(k)
        3489             :         !  ! Limit trten(k,m) such that negative value is not developed.
        3490             :         !  ! This limitation does not conserve grid-mean tracers and future
        3491             :         !  ! refinement is required for tracer-conserving treatment.
        3492             :         !    trten(k,m) = max(trten(k,m),-tr0(k,m)/dt)
        3493             :         ! enddo
        3494             :        end do
        3495             :
        3496             :        ! ----------------------------------------------------------------- !
        3497             :        ! Tendencies of thermodynamic variables.                            !
        3498             :        ! This part requires a careful treatment of bulk cloud microphysics.!
        3499             :        ! Relocations of 'precipitable condensates' either into the surface !
        3500             :        ! or into the tendency of 'krel' layer will be performed just after !
        3501             :        ! finishing the below 'do-loop'.                                    !
        3502             :        ! ----------------------------------------------------------------- !
        3503             :
        3504             :        rliq    = 0._r8
        3505             :        rainflx = 0._r8
        3506             :        snowflx = 0._r8
        3507             :
        3508           0 :        do k = 1, kpen
        3509             :
        3510           0 :           km1 = k - 1
        3511             :
        3512             :           ! ------------------------------------------------------------------------------ !
        3513             :           ! Compute 'slten', 'qtten', 'qvten', 'qlten', 'qiten', and 'sten'                !
        3514             :           !                                                                                !
        3515             :           ! Key assumptions made in this 'cumulus scheme' are :                            !
        3516             :           ! 1. Cumulus updraft expels condensate into the environment at the top interface !
        3517             :           !    of each layer. Note that in addition to this expel process ('source' term), !
        3518             :           !    cumulus updraft can modify layer mean condensate through normal detrainment !
        3519             :           !    forcing or compensating subsidence.                                         !
        3520             :           ! 2. Expelled water can be either 'sustaining' or 'precipitating' condensate. By !
        3521             :           !    definition, 'suataining condensate' will remain in the layer where it was   !
        3522             :           !    formed, while 'precipitating condensate' will fall across the base of the   !
        3523             :           !    layer where it was formed.                                                  !
        3524             :           ! 3. All precipitating condensates are assumed to fall into the release layer or !
        3525             :           !    ground as soon as it was formed without being evaporated during the falling !
        3526             :           !    process down to the desinated layer ( either release layer of surface ).    !
        3527             :           ! ------------------------------------------------------------------------------ !
        3528             :
        3529             :           ! ------------------------------------------------------------------------- !
        3530             :           ! 'dwten(k)','diten(k)' : Production rate of condensate  within the layer k !
        3531             :           !      [ kg/kg/s ]        by the expels of condensate from cumulus updraft. !
        3532             :           ! It is important to note that in terms of moisture tendency equation, this !
        3533             :           ! is a 'source' term of enviromental 'qt'.  More importantly,  these source !
        3534             :           ! are already counted in the turbulent heat and moisture fluxes we computed !
        3535             :           ! until now, assuming all the expelled condensate remain in the layer where !
        3536             :           ! it was formed. Thus, in calculation of 'qtten' and 'slten' below, we MUST !
        3537             :           ! NOT add or subtract these terms explicitly in order not to double or miss !
        3538             :           ! count, unless some expelled condensates fall down out of the layer.  Note !
        3539             :           ! this falling-down process ( i.e., precipitation process ) and  associated !
        3540             :           ! 'qtten' and 'slten' and production of surface precipitation flux  will be !
        3541             :           ! treated later in 'zm_conv_evap' in 'convect_shallow_tend' subroutine.     !
        3542             :           ! In below, we are converting expelled cloud condensate into correct unit.  !
        3543             :           ! I found that below use of '0.5 * (umf(k-1) + umf(k))' causes conservation !
        3544             :           ! errors at some columns in global simulation. So, I returned to originals. !
        3545             :           ! This will cause no precipitation flux at 'kpen' layer since umf(kpen)=0.  !
        3546             :           ! ------------------------------------------------------------------------- !
        3547             :
        3548           0 :           dwten(k) = dwten(k) * 0.5_r8 * ( umf(k-1) + umf(k) ) * g / dp0(k) ! [ kg/kg/s ]
        3549           0 :           diten(k) = diten(k) * 0.5_r8 * ( umf(k-1) + umf(k) ) * g / dp0(k) ! [ kg/kg/s ]
        3550             :
        3551             :           ! dwten(k) = dwten(k) * umf(k) * g / dp0(k) ! [ kg/kg/s ]
        3552             :           ! diten(k) = diten(k) * umf(k) * g / dp0(k) ! [ kg/kg/s ]
        3553             :
        3554             :           ! --------------------------------------------------------------------------- !
        3555             :           ! 'qrten(k)','qsten(k)' : Production rate of rain and snow within the layer k !
        3556             :           !     [ kg/kg/s ]         by cumulus expels of condensates to the environment.!
        3557             :           ! This will be falled-out of the layer where it was formed and will be dumped !
        3558             :           ! dumped into the release layer assuming that there is no evaporative cooling !
        3559             :           ! while precipitable condensate moves to the relaes level. This is reasonable !
        3560             :           ! assumtion if cumulus is purely vertical and so the path along which precita !
        3561             :           ! ble condensate falls is fully saturared. This 're-allocation' process of    !
        3562             :           ! precipitable condensate into the release layer is fully described in this   !
        3563             :           ! convection scheme. After that, the dumped water into the release layer will !
        3564             :           ! falling down across the base of release layer ( or LCL, if  exact treatment !
        3565             :           ! is required ) and will be allowed to be evaporated in layers below  release !
        3566             :           ! layer, and finally non-zero surface precipitation flux will be calculated.  !
        3567             :           ! This latter process will be separately treated 'zm_conv_evap' routine.      !
        3568             :           ! --------------------------------------------------------------------------- !
        3569             :
        3570           0 :           qrten(k) = frc_rasn * dwten(k)
        3571           0 :           qsten(k) = frc_rasn * diten(k)
        3572             :
        3573             :           ! ----------------------------------------------------------------------- !
        3574             :           ! 'rainflx','snowflx' : Cumulative rain and snow flux integrated from the !
        3575             :           !     [ kg/m2/s ]       release leyer to the 'kpen' layer. Note that even !
        3576             :           ! though wtw(kpen) < 0 (and umf(kpen) = 0) at the top interface of 'kpen' !
        3577             :           ! layer, 'dwten(kpen)' and diten(kpen)  were calculated after calculating !
        3578             :           ! explicit cloud top height. Thus below calculation of precipitation flux !
        3579             :           ! is correct. Note that  precipitating condensates are formed only in the !
        3580             :           ! layers from 'krel' to 'kpen', including the two layers.                 !
        3581             :           ! ----------------------------------------------------------------------- !
        3582             :
        3583           0 :           rainflx = rainflx + qrten(k) * dp0(k) / g
        3584           0 :           snowflx = snowflx + qsten(k) * dp0(k) / g
        3585             :
        3586             :           ! ------------------------------------------------------------------------ !
        3587             :           ! 'slten(k)','qtten(k)'                                                    !
        3588             :           !  Note that 'slflx(k)' and 'qtflx(k)' we have calculated already included !
        3589             :           !  all the contributions of (1) expels of condensate (dwten(k), diten(k)), !
        3590             :           !  (2) mass detrainment ( delta * umf * ( qtu - qt ) ), & (3) compensating !
        3591             :           !  subsidence ( M * dqt / dz ). Thus 'slflx(k)' and 'qtflx(k)' we computed !
        3592             :           !  is a hybrid turbulent flux containing one part of 'source' term - expel !
        3593             :           !  of condensate. In order to calculate 'slten' and 'qtten', we should add !
        3594             :           !  additional 'source' term, if any. If the expelled condensate falls down !
        3595             :           !  across the base of the layer, it will be another sink (negative source) !
        3596             :           !  term.  Note also that we included frictional heating terms in the below !
        3597             :           !  calculation of 'slten'.                                                 !
        3598             :           ! ------------------------------------------------------------------------ !
        3599             :
        3600           0 :           slten(k) = ( slflx(km1) - slflx(k) ) * g / dp0(k)
        3601           0 :           if( k .eq. 1 ) then
        3602             :               slten(k) = slten(k) - g / 4._r8 / dp0(k) * (                            &
        3603           0 :                                     uflx(k)*(uf(k+1) - uf(k) + u0(k+1) - u0(k)) +     &
        3604           0 :                                     vflx(k)*(vf(k+1) - vf(k) + v0(k+1) - v0(k)))
        3605           0 :           elseif( k .ge. 2 .and. k .le. kpen-1 ) then
        3606             :               slten(k) = slten(k) - g / 4._r8 / dp0(k) * (                            &
        3607           0 :                                     uflx(k)*(uf(k+1) - uf(k) + u0(k+1) - u0(k)) +     &
        3608           0 :                                     uflx(k-1)*(uf(k) - uf(k-1) + u0(k) - u0(k-1)) +   &
        3609             :                                     vflx(k)*(vf(k+1) - vf(k) + v0(k+1) - v0(k)) +     &
        3610           0 :                                     vflx(k-1)*(vf(k) - vf(k-1) + v0(k) - v0(k-1)))
        3611           0 :           elseif( k .eq. kpen ) then
        3612             :               slten(k) = slten(k) - g / 4._r8 / dp0(k) * (                            &
        3613           0 :                                     uflx(k-1)*(uf(k) - uf(k-1) + u0(k) - u0(k-1)) +   &
        3614           0 :                                     vflx(k-1)*(vf(k) - vf(k-1) + v0(k) - v0(k-1)))
        3615             :           endif
        3616           0 :           qtten(k) = ( qtflx(km1) - qtflx(k) ) * g / dp0(k)
        3617             :
        3618             :           ! ---------------------------------------------------------------------------- !
        3619             :           ! Compute condensate tendency, including reserved condensate                   !
        3620             :           ! We assume that eventual detachment and detrainment occurs in kbup layer  due !
        3621             :           ! to downdraft buoyancy sorting. In the layer above the kbup, only penetrative !
        3622             :           ! entrainment exists. Penetrative entrained air is assumed not to contain any  !
        3623             :           ! condensate.                                                                  !
        3624             :           ! ---------------------------------------------------------------------------- !
        3625             :
        3626             :           ! Compute in-cumulus condensate at the layer mid-point.
        3627             :
        3628           0 :           if( k .lt. krel .or. k .gt. kpen ) then
        3629           0 :               qlu_mid = 0._r8
        3630           0 :               qiu_mid = 0._r8
        3631           0 :               qlj     = 0._r8
        3632           0 :               qij     = 0._r8
        3633           0 :           elseif( k .eq. krel ) then
        3634           0 :               call conden(prel,thlu(krel-1),qtu(krel-1),thj,qvj,qlj,qij,qse,id_check)
        3635           0 :               if( id_check .eq. 1 ) then
        3636           0 :                   exit_conden(i) = 1._r8
        3637           0 :                   id_exit = .true.
        3638           0 :                   go to 333
        3639             :               endif
        3640           0 :               qlubelow = qlj
        3641           0 :               qiubelow = qij
        3642           0 :               call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check)
        3643           0 :               if( id_check .eq. 1 ) then
        3644           0 :                   exit_conden(i) = 1._r8
        3645           0 :                   id_exit = .true.
        3646           0 :                   go to 333
        3647             :               end if
        3648           0 :               qlu_mid = 0.5_r8 * ( qlubelow + qlj ) * ( prel - ps0(k) )/( ps0(k-1) - ps0(k) )
        3649           0 :               qiu_mid = 0.5_r8 * ( qiubelow + qij ) * ( prel - ps0(k) )/( ps0(k-1) - ps0(k) )
        3650           0 :           elseif( k .eq. kpen ) then
        3651           0 :               call conden(ps0(k-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check)
        3652           0 :               if( id_check .eq. 1 ) then
        3653           0 :                   exit_conden(i) = 1._r8
        3654           0 :                   id_exit = .true.
        3655           0 :                   go to 333
        3656             :               end if
        3657           0 :               qlu_mid = 0.5_r8 * ( qlubelow + qlj ) * ( -ppen )        /( ps0(k-1) - ps0(k) )
        3658           0 :               qiu_mid = 0.5_r8 * ( qiubelow + qij ) * ( -ppen )        /( ps0(k-1) - ps0(k) )
        3659           0 :               qlu_top = qlj
        3660           0 :               qiu_top = qij
        3661             :           else
        3662           0 :               call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check)
        3663           0 :               if( id_check .eq. 1 ) then
        3664           0 :                   exit_conden(i) = 1._r8
        3665           0 :                   id_exit = .true.
        3666           0 :                   go to 333
        3667             :               end if
        3668           0 :               qlu_mid = 0.5_r8 * ( qlubelow + qlj )
        3669           0 :               qiu_mid = 0.5_r8 * ( qiubelow + qij )
        3670             :           endif
        3671           0 :           qlubelow = qlj
        3672           0 :           qiubelow = qij
        3673             :
        3674             :           ! 1. Sustained Precipitation
        3675             :
        3676           0 :           qc_l(k) = ( 1._r8 - frc_rasn ) * dwten(k) ! [ kg/kg/s ]
        3677           0 :           qc_i(k) = ( 1._r8 - frc_rasn ) * diten(k) ! [ kg/kg/s ]
        3678             :
        3679             :           ! 2. Detrained Condensate
        3680             :
        3681           0 :           if( k .le. kbup ) then
        3682           0 :               qc_l(k) = qc_l(k) + g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qlu_mid ! [ kg/kg/s ]
        3683           0 :               qc_i(k) = qc_i(k) + g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qiu_mid ! [ kg/kg/s ]
        3684           0 :               qc_lm   =         - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * ql0(k)
        3685           0 :               qc_im   =         - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * qi0(k)
        3686             :             ! Below 'nc_lm', 'nc_im' should be used only when frc_rasn = 1.
        3687           0 :               nc_lm   =         - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * tr0(k,ixnumliq)
        3688           0 :               nc_im   =         - g * 0.5_r8 * ( umf(k-1) + umf(k) ) * fdr(k) * tr0(k,ixnumice)
        3689             :           else
        3690             :               qc_lm   = 0._r8
        3691             :               qc_im   = 0._r8
        3692             :               nc_lm   = 0._r8
        3693             :               nc_im   = 0._r8
        3694             :           endif
        3695             :
        3696             :           ! 3. Detached Updraft
        3697             :
        3698           0 :           if( k .eq. kbup ) then
        3699           0 :               qc_l(k) = qc_l(k) + g * umf(k) * qlj     / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3700           0 :               qc_i(k) = qc_i(k) + g * umf(k) * qij     / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3701           0 :               qc_lm   = qc_lm   - g * umf(k) * ql0(k)  / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3702           0 :               qc_im   = qc_im   - g * umf(k) * qi0(k)  / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3703           0 :               nc_lm   = nc_lm   - g * umf(k) * tr0(k,ixnumliq)  / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3704           0 :               nc_im   = nc_im   - g * umf(k) * tr0(k,ixnumice)  / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3705             :           endif
        3706             :
        3707             :           ! 4. Cumulative Penetrative entrainment detrained in the 'kbup' layer
        3708             :           !    Explicitly compute the properties detrained penetrative entrained airs in k = kbup layer.
        3709             :
        3710           0 :           if( k .eq. kbup ) then
        3711           0 :               call conden(p0(k),thlu_emf(k),qtu_emf(k),thj,qvj,ql_emf_kbup,qi_emf_kbup,qse,id_check)
        3712           0 :               if( id_check .eq. 1 ) then
        3713             :                   id_exit = .true.
        3714             :                   go to 333
        3715             :               endif
        3716           0 :               if( ql_emf_kbup .gt. 0._r8 ) then
        3717           0 :                   nl_emf_kbup = tru_emf(k,ixnumliq)
        3718             :               else
        3719             :                   nl_emf_kbup = 0._r8
        3720             :               endif
        3721           0 :               if( qi_emf_kbup .gt. 0._r8 ) then
        3722           0 :                   ni_emf_kbup = tru_emf(k,ixnumice)
        3723             :               else
        3724             :                   ni_emf_kbup = 0._r8
        3725             :               endif
        3726           0 :               qc_lm   = qc_lm   - g * emf(k) * ( ql_emf_kbup - ql0(k) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3727           0 :               qc_im   = qc_im   - g * emf(k) * ( qi_emf_kbup - qi0(k) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3728           0 :               nc_lm   = nc_lm   - g * emf(k) * ( nl_emf_kbup - tr0(k,ixnumliq) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3729           0 :               nc_im   = nc_im   - g * emf(k) * ( ni_emf_kbup - tr0(k,ixnumice) ) / ( ps0(k-1) - ps0(k) ) ! [ kg/kg/s ]
        3730             :           endif
        3731             :
        3732           0 :           qlten_det   = qc_l(k) + qc_lm
        3733           0 :           qiten_det   = qc_i(k) + qc_im
        3734             :
        3735             :           ! --------------------------------------------------------------------------------- !
        3736             :           ! 'qlten(k)','qiten(k)','qvten(k)','sten(k)'                                        !
        3737             :           ! Note that falling of precipitation will be treated later.                         !
        3738             :           ! The prevension of negative 'qv,ql,qi' will be treated later in positive_moisture. !
        3739             :           ! --------------------------------------------------------------------------------- !
        3740             :
        3741             :           if( use_expconten ) then
        3742             :               if( use_unicondet ) then
        3743             :                   qc_l(k) = 0._r8
        3744             :                   qc_i(k) = 0._r8
        3745             :                   qlten(k) = frc_rasn * dwten(k) + qlten_sink(k) + qlten_det
        3746             :                   qiten(k) = frc_rasn * diten(k) + qiten_sink(k) + qiten_det
        3747             :               else
        3748           0 :                   qlten(k) = qc_l(k) + frc_rasn * dwten(k) + ( max( 0._r8, ql0(k) + ( qc_lm + qlten_sink(k) ) * dt ) - ql0(k) ) / dt
        3749           0 :                   qiten(k) = qc_i(k) + frc_rasn * diten(k) + ( max( 0._r8, qi0(k) + ( qc_im + qiten_sink(k) ) * dt ) - qi0(k) ) / dt
        3750           0 :                   trten(k,ixnumliq) = max( nc_lm + nlten_sink(k), - tr0(k,ixnumliq) / dt )
        3751           0 :                   trten(k,ixnumice) = max( nc_im + niten_sink(k), - tr0(k,ixnumice) / dt )
        3752             :               endif
        3753             :           else
        3754             :               if( use_unicondet ) then
        3755             :                   qc_l(k) = 0._r8
        3756             :                   qc_i(k) = 0._r8
        3757             :               endif
        3758             :               qlten(k) = dwten(k) + ( qtten(k) - dwten(k) - diten(k) ) * ( ql0(k) / qt0(k) )
        3759             :               qiten(k) = diten(k) + ( qtten(k) - dwten(k) - diten(k) ) * ( qi0(k) / qt0(k) )
        3760             :           endif
        3761             :
        3762           0 :           qvten(k) = qtten(k) - qlten(k) - qiten(k)
        3763           0 :           sten(k)  = slten(k) + xlv * qlten(k) + xls * qiten(k)
        3764             :
        3765             :           ! -------------------------------------------------------------------------- !
        3766             :           ! 'rliq' : Verticall-integrated 'suspended cloud condensate'                 !
        3767             :           !  [m/s]   This is so called 'reserved liquid water'  in other subroutines   !
        3768             :           ! of CAM, since the contribution of this term should not be included into   !
        3769             :           ! the tendency of each layer or surface flux (precip)  within this cumulus   !
        3770             :           ! scheme. The adding of this term to the layer tendency will be done inthe   !
        3771             :           ! 'stratiform_tend', just after performing sediment process there.           !
        3772             :           ! The main problem of these rather going-back-and-forth and stupid-seeming   !
        3773             :           ! approach is that the sediment process of suspendened condensate will not   !
        3774             :           ! be treated at all in the 'stratiform_tend'.                                !
        3775             :           ! Note that 'precip' [m/s] is vertically-integrated total 'rain+snow' formed !
        3776             :           ! from the cumulus updraft. Important : in the below, 1000 is rhoh2o ( water !
        3777             :           ! density ) [ kg/m^3 ] used for unit conversion from [ kg/m^2/s ] to [ m/s ] !
        3778             :           ! for use in stratiform.F90.                                                 !
        3779             :           ! -------------------------------------------------------------------------- !
        3780             :
        3781           0 :           qc(k)  =  qc_l(k) +  qc_i(k)
        3782           0 :           rliq   =  rliq    + qc(k) * dp0(k) / g / 1000._r8    ! [ m/s ]
        3783             :
        3784             :        end do
        3785             :
        3786           0 :           precip  =  rainflx + snowflx                       ! [ kg/m2/s ]
        3787           0 :           snow    =  snowflx                                 ! [ kg/m2/s ]
        3788             :
        3789             :        ! ---------------------------------------------------------------- !
        3790             :        ! Now treats the 'evaporation' and 'melting' of rain ( qrten ) and !
        3791             :        ! snow ( qsten ) during falling process. Below algorithms are from !
        3792             :        ! 'zm_conv_evap' but with some modification, which allows separate !
        3793             :        ! treatment of 'rain' and 'snow' condensates. Note that I included !
        3794             :        ! the evaporation dynamics into the convection scheme for complete !
        3795             :        ! development of cumulus scheme especially in association with the !
        3796             :        ! implicit CIN closure. In compatible with this internal treatment !
        3797             :        ! of evaporation, I should modify 'convect_shallow',  in such that !
        3798             :        ! 'zm_conv_evap' is not performed when I choose UW PBL-Cu schemes. !
        3799             :        ! ---------------------------------------------------------------- !
        3800             :
        3801           0 :        evpint_rain    = 0._r8
        3802           0 :        evpint_snow    = 0._r8
        3803           0 :        flxrain(0:mkx) = 0._r8
        3804           0 :        flxsnow(0:mkx) = 0._r8
        3805           0 :        ntraprd(:mkx)  = 0._r8
        3806           0 :        ntsnprd(:mkx)  = 0._r8
        3807             :
        3808           0 :        do k = mkx, 1, -1  ! 'k' is a layer index : 'mkx'('1') is the top ('bottom') layer
        3809             :
        3810             :           ! ----------------------------------------------------------------------------- !
        3811             :           ! flxsntm [kg/m2/s] : Downward snow flux at the top of each layer after melting.!
        3812             :           ! snowmlt [kg/kg/s] : Snow melting tendency.                                    !
        3813             :           ! Below allows melting of snow when it goes down into the warm layer below.     !
        3814             :           ! ----------------------------------------------------------------------------- !
        3815             :
        3816           0 :           if( t0(k) .gt. 273.16_r8 ) then
        3817           0 :               snowmlt = max( 0._r8, flxsnow(k) * g / dp0(k) )
        3818             :           else
        3819             :               snowmlt = 0._r8
        3820             :           endif
        3821             :
        3822             :           ! ----------------------------------------------------------------- !
        3823             :           ! Evaporation rate of 'rain' and 'snow' in the layer k, [ kg/kg/s ] !
        3824             :           ! where 'rain' and 'snow' are coming down from the upper layers.    !
        3825             :           ! I used the same evaporative efficiency both for 'rain' and 'snow'.!
        3826             :           ! Note that evaporation is not allowed in the layers 'k >= krel' by !
        3827             :           ! assuming that inside of cumulus cloud, across which precipitation !
        3828             :           ! is falling down, is fully saturated.                              !
        3829             :           ! The asumptions in association with the 'evplimit_rain(snow)' are  !
        3830             :           !   1. Do not allow evaporation to supersate the layer              !
        3831             :           !   2. Do not evaporate more than the flux falling into the layer   !
        3832             :           !   3. Total evaporation cannot exceed the input total surface flux !
        3833             :           ! ----------------------------------------------------------------- !
        3834             :
        3835           0 :           call qsat(t0(k), p0(k), es, qs)
        3836           0 :           subsat = max( ( 1._r8 - qv0(k)/qs ), 0._r8 )
        3837             :           if( noevap_krelkpen ) then
        3838             :               if( k .ge. krel ) subsat = 0._r8
        3839             :           endif
        3840             :
        3841           0 :           evprain  = kevp * subsat * sqrt(flxrain(k)+snowmlt*dp0(k)/g)
        3842           0 :           evpsnow  = kevp * subsat * sqrt(max(flxsnow(k)-snowmlt*dp0(k)/g,0._r8))
        3843             :
        3844           0 :           evplimit = max( 0._r8, ( qw0_in(i,k) - qv0(k) ) / dt )
        3845             :
        3846           0 :           evplimit_rain = min( evplimit,      ( flxrain(k) + snowmlt * dp0(k) / g ) * g / dp0(k) )
        3847           0 :           evplimit_rain = min( evplimit_rain, ( rainflx - evpint_rain ) * g / dp0(k) )
        3848           0 :           evprain = max(0._r8,min( evplimit_rain, evprain ))
        3849             :
        3850           0 :           evplimit_snow = min( evplimit,   max( flxsnow(k) - snowmlt * dp0(k) / g , 0._r8 ) * g / dp0(k) )
        3851           0 :           evplimit_snow = min( evplimit_snow, ( snowflx - evpint_snow ) * g / dp0(k) )
        3852           0 :           evpsnow = max(0._r8,min( evplimit_snow, evpsnow ))
        3853             :
        3854           0 :           if( ( evprain + evpsnow ) .gt. evplimit ) then
        3855           0 :                 tmp1 = evprain * evplimit / ( evprain + evpsnow )
        3856           0 :                 tmp2 = evpsnow * evplimit / ( evprain + evpsnow )
        3857           0 :                 evprain = tmp1
        3858           0 :                 evpsnow = tmp2
        3859             :           endif
        3860             :
        3861           0 :           evapc(k) = evprain + evpsnow
        3862             :
        3863             :           ! ------------------------------------------------------------- !
        3864             :           ! Vertically-integrated evaporative fluxes of 'rain' and 'snow' !
        3865             :           ! ------------------------------------------------------------- !
        3866             :
        3867           0 :           evpint_rain = evpint_rain + evprain * dp0(k) / g
        3868           0 :           evpint_snow = evpint_snow + evpsnow * dp0(k) / g
        3869             :
        3870             :           ! -------------------------------------------------------------- !
        3871             :           ! Net 'rain' and 'snow' production rate in the layer [ kg/kg/s ] !
        3872             :           ! -------------------------------------------------------------- !
        3873             :
        3874           0 :           ntraprd(k) = qrten(k) - evprain + snowmlt
        3875           0 :           ntsnprd(k) = qsten(k) - evpsnow - snowmlt
        3876             :
        3877             :           ! -------------------------------------------------------------------------------- !
        3878             :           ! Downward fluxes of 'rain' and 'snow' fluxes at the base of the layer [ kg/m2/s ] !
        3879             :           ! Note that layer index increases with height.                                     !
        3880             :           ! -------------------------------------------------------------------------------- !
        3881             :
        3882           0 :           flxrain(k-1) = flxrain(k) + ntraprd(k) * dp0(k) / g
        3883           0 :           flxsnow(k-1) = flxsnow(k) + ntsnprd(k) * dp0(k) / g
        3884           0 :           flxrain(k-1) = max( flxrain(k-1), 0._r8 )
        3885           0 :           if( flxrain(k-1) .eq. 0._r8 ) ntraprd(k) = -flxrain(k) * g / dp0(k)
        3886           0 :           flxsnow(k-1) = max( flxsnow(k-1), 0._r8 )
        3887           0 :           if( flxsnow(k-1) .eq. 0._r8 ) ntsnprd(k) = -flxsnow(k) * g / dp0(k)
        3888             :
        3889             :           ! ---------------------------------- !
        3890             :           ! Calculate thermodynamic tendencies !
        3891             :           ! --------------------------------------------------------------------------- !
        3892             :           ! Note that equivalently, we can write tendency formula of 'sten' and 'slten' !
        3893             :           ! by 'sten(k)  = sten(k) - xlv*evprain  - xls*evpsnow - (xls-xlv)*snowmlt' &  !
        3894             :           !    'slten(k) = sten(k) - xlv*qlten(k) - xls*qiten(k)'.                      !
        3895             :           ! The above formula is equivalent to the below formula. However below formula !
        3896             :           ! is preferred since we have already imposed explicit constraint on 'ntraprd' !
        3897             :           ! and 'ntsnprd' in case that flxrain(k-1) < 0 & flxsnow(k-1) < 0._r8          !
        3898             :           ! Note : In future, I can elborate the limiting of 'qlten','qvten','qiten'    !
        3899             :           !        such that that energy and moisture conservation error is completely  !
        3900             :           !        suppressed.                                                          !
        3901             :           ! Re-storation to the positive condensate will be performed later below       !
        3902             :           ! --------------------------------------------------------------------------- !
        3903             :
        3904           0 :           qlten(k) = qlten(k) - qrten(k)
        3905           0 :           qiten(k) = qiten(k) - qsten(k)
        3906           0 :           qvten(k) = qvten(k) + evprain  + evpsnow
        3907           0 :           qtten(k) = qlten(k) + qiten(k) + qvten(k)
        3908             :           if( ( qv0(k) + qvten(k)*dt ) .lt. qmin(1) .or. &
        3909           0 :               ( ql0(k) + qlten(k)*dt ) .lt. qmin(ixcldliq) .or. &
        3910           0 :               ( qi0(k) + qiten(k)*dt ) .lt. qmin(ixcldice) ) then
        3911           0 :                limit_negcon(i) = 1._r8
        3912             :           end if
        3913           0 :           sten(k)  = sten(k) - xlv*evprain  - xls*evpsnow - (xls-xlv)*snowmlt
        3914           0 :           slten(k) = sten(k) - xlv*qlten(k) - xls*qiten(k)
        3915             :
        3916             :         !  slten(k) = slten(k) + xlv * ntraprd(k) + xls * ntsnprd(k)
        3917             :         !  sten(k)  = slten(k) + xlv * qlten(k)   + xls * qiten(k)
        3918             :
        3919             :        end do
        3920             :
        3921             :        ! ------------------------------------------------------------- !
        3922             :        ! Calculate final surface flux of precipitation, rain, and snow !
        3923             :        ! Convert unit to [m/s] for use in 'check_energy_chng'.         !
        3924             :        ! ------------------------------------------------------------- !
        3925             :
        3926           0 :        precip  = ( flxrain(0) + flxsnow(0) ) / 1000._r8
        3927           0 :        snow    =   flxsnow(0) / 1000._r8
        3928             :
        3929             :        ! --------------------------------------------------------------------------- !
        3930             :        ! Until now, all the calculations are done completely in this shallow cumulus !
        3931             :        ! scheme. If you want to use this cumulus scheme other than CAM, then do not !
        3932             :        ! perform below block. However, for compatible use with the other subroutines !
        3933             :        ! in CAM, I should subtract the effect of 'qc(k)' ('rliq') from the tendency !
        3934             :        ! equation in each layer, since this effect will be separately added later in !
        3935             :        ! in 'stratiform_tend' just after performing sediment process there. In order !
        3936             :        ! to be consistent with 'stratiform_tend', just subtract qc(k)  from tendency !
        3937             :        ! equation of each layer, but do not add it to the 'precip'. Apprently,  this !
        3938             :        ! will violate energy and moisture conservations.    However, when performing !
        3939             :        ! conservation check in 'tphysbc.F90' just after 'convect_shallow_tend',   we !
        3940             :        ! will add 'qc(k)' ( rliq ) to the surface flux term just for the purpose  of !
        3941             :        ! passing the energy-moisture conservation check. Explicit adding-back of 'qc'!
        3942             :        ! to the individual layer tendency equation will be done in 'stratiform_tend' !
        3943             :        ! after performing sediment process there. Simply speaking, in 'tphysbc' just !
        3944             :        ! after 'convect_shallow_tend', we will dump 'rliq' into surface as a  'rain' !
        3945             :        ! in order to satisfy energy and moisture conservation, and  in the following !
        3946             :        ! 'stratiform_tend', we will restore it back to 'qlten(k)' ( 'ice' will go to !
        3947             :        ! 'water' there) from surface precipitation. This is a funny but conceptually !
        3948             :        ! entertaining procedure. One concern I have for this complex process is that !
        3949             :        ! output-writed stratiform precipitation amount will be underestimated due to !
        3950             :        ! arbitrary subtracting of 'rliq' in stratiform_tend, where                   !
        3951             :        ! ' prec_str = prec_sed + prec_pcw - rliq' and 'rliq' is not real but fake.   !
        3952             :        ! However, as shown in 'srfxfer.F90', large scale precipitation amount (PRECL)!
        3953             :        ! that is writed-output is corrected written since in 'srfxfer.F90',  PRECL = !
        3954             :        ! 'prec_sed + prec_pcw', without including 'rliq'. So current code is correct.!
        3955             :        ! Note also in 'srfxfer.F90', convective precipitation amount is 'PRECC =     !
        3956             :        ! prec_zmc(i) + prec_cmf(i)' which is also correct.                           !
        3957             :        ! --------------------------------------------------------------------------- !
        3958             :
        3959           0 :        do k = 1, kpen
        3960           0 :           qtten(k) = qtten(k) - qc(k)
        3961           0 :           qlten(k) = qlten(k) - qc_l(k)
        3962           0 :           qiten(k) = qiten(k) - qc_i(k)
        3963           0 :           slten(k) = slten(k) + ( xlv * qc_l(k) + xls * qc_i(k) )
        3964             :           ! ---------------------------------------------------------------------- !
        3965             :           ! Since all reserved condensates will be treated  as liquid water in the !
        3966             :           ! 'check_energy_chng' & 'stratiform_tend' without an explicit conversion !
        3967             :           ! algorithm, I should consider explicitly the energy conversions between !
        3968             :           ! 'ice' and 'liquid' - i.e., I should convert 'ice' to 'liquid'  and the !
        3969             :           ! necessary energy for this conversion should be subtracted from 'sten'. !
        3970             :           ! Without this conversion here, energy conservation error come out. Note !
        3971             :           ! that there should be no change of 'qvten(k)'.                          !
        3972             :           ! ---------------------------------------------------------------------- !
        3973           0 :           sten(k)  = sten(k)  - ( xls - xlv ) * qc_i(k)
        3974             :        end do
        3975             :
        3976             :        ! --------------------------------------------------------------- !
        3977             :        ! Prevent the onset-of negative condensate at the next time step  !
        3978             :        ! Potentially, this block can be moved just in front of the above !
        3979             :        ! block.                                                          !
        3980             :        ! --------------------------------------------------------------- !
        3981             :
        3982             :        ! Modification : I should check whether this 'positive_moisture_single' routine is
        3983             :        !                consistent with the one used in UW PBL and cloud macrophysics schemes.
        3984             :        ! Modification : Below may overestimate resulting 'ql, qi' if we use the new 'qc_l', 'qc_i'
        3985             :        !                in combination with the original computation of qlten, qiten. However,
        3986             :        !                if we use new 'qlten,qiten', there is no problem.
        3987             :
        3988           0 :         qv0_star(:mkx) = qv0(:mkx) + qvten(:mkx) * dt
        3989           0 :         ql0_star(:mkx) = ql0(:mkx) + qlten(:mkx) * dt
        3990           0 :         qi0_star(:mkx) = qi0(:mkx) + qiten(:mkx) * dt
        3991           0 :         s0_star(:mkx)  =  s0(:mkx) +  sten(:mkx) * dt
        3992           0 :         call positive_moisture_single( xlv, xls, mkx, dt, qmin(1), qmin(ixcldliq), qmin(ixcldice), &
        3993           0 :              dp0, qv0_star, ql0_star, qi0_star, s0_star, qvten, qlten, qiten, sten )
        3994           0 :         qtten(:mkx)    = qvten(:mkx) + qlten(:mkx) + qiten(:mkx)
        3995           0 :         slten(:mkx)    = sten(:mkx)  - xlv * qlten(:mkx) - xls * qiten(:mkx)
        3996             :
        3997             :        ! --------------------- !
        3998             :        ! Tendencies of tracers !
        3999             :        ! --------------------- !
        4000             :
        4001           0 :        do m = 4, ncnst
        4002             :
        4003           0 :        if( m .ne. ixnumliq .and. m .ne. ixnumice ) then
        4004             :
        4005           0 :           trmin = qmin(m)
        4006           0 :           trflx_d(0:mkx) = 0._r8
        4007           0 :           trflx_u(0:mkx) = 0._r8
        4008           0 :           do k = 1, mkx-1
        4009           0 :              if( cnst_get_type_byind(m) .eq. 'wet' ) then
        4010           0 :                  pdelx = dp0(k)
        4011             :              else
        4012           0 :                  pdelx = dpdry0(k)
        4013             :              endif
        4014           0 :              km1 = k - 1
        4015           0 :              dum = ( tr0(k,m) - trmin ) *  pdelx / g / dt + trflx(km1,m) - trflx(k,m) + trflx_d(km1)
        4016           0 :              trflx_d(k) = min( 0._r8, dum )
        4017             :           enddo
        4018           0 :           do k = mkx, 2, -1
        4019           0 :              if( cnst_get_type_byind(m) .eq. 'wet' ) then
        4020           0 :                  pdelx = dp0(k)
        4021             :              else
        4022           0 :                  pdelx = dpdry0(k)
        4023             :              endif
        4024           0 :              km1 = k - 1
        4025           0 :              dum = ( tr0(k,m) - trmin ) * pdelx / g / dt + trflx(km1,m) - trflx(k,m) + &
        4026           0 :                                                            trflx_d(km1) - trflx_d(k) - trflx_u(k)
        4027           0 :              trflx_u(km1) = max( 0._r8, -dum )
        4028             :           enddo
        4029           0 :           do k = 1, mkx
        4030           0 :              if( cnst_get_type_byind(m) .eq. 'wet' ) then
        4031           0 :                  pdelx = dp0(k)
        4032             :              else
        4033           0 :                  pdelx = dpdry0(k)
        4034             :              endif
        4035           0 :              km1 = k - 1
        4036             :            ! Check : I should re-check whether '_u', '_d' are correctly ordered in
        4037             :            !         the below tendency computation.
        4038           0 :              trten(k,m) = ( trflx(km1,m) - trflx(k,m) + &
        4039             :                             trflx_d(km1) - trflx_d(k) + &
        4040           0 :                             trflx_u(km1) - trflx_u(k) ) * g / pdelx
        4041             :           enddo
        4042             :
        4043             :        endif
        4044             :
        4045             :        enddo
        4046             :
        4047             :        ! ---------------------------------------------------------------- !
        4048             :        ! Cumpute default diagnostic outputs                               !
        4049             :        ! Note that since 'qtu(krel-1:kpen-1)' & 'thlu(krel-1:kpen-1)' has !
        4050             :        ! been adjusted after detraining cloud condensate into environment !
        4051             :        ! during cumulus updraft motion,  below calculations will  exactly !
        4052             :        ! reproduce in-cloud properties as shown in the output analysis.   !
        4053             :        ! ---------------------------------------------------------------- !
        4054             :
        4055           0 :        call conden(prel,thlu(krel-1),qtu(krel-1),thj,qvj,qlj,qij,qse,id_check)
        4056           0 :        if( id_check .eq. 1 ) then
        4057           0 :            exit_conden(i) = 1._r8
        4058           0 :            id_exit = .true.
        4059           0 :            go to 333
        4060             :        end if
        4061           0 :        qcubelow = qlj + qij
        4062           0 :        qlubelow = qlj
        4063           0 :        qiubelow = qij
        4064           0 :        rcwp     = 0._r8
        4065           0 :        rlwp     = 0._r8
        4066           0 :        riwp     = 0._r8
        4067             :
        4068             :        ! --------------------------------------------------------------------- !
        4069             :        ! In the below calculations, I explicitly considered cloud base ( LCL ) !
        4070             :        ! and cloud top height ( ps0(kpen-1) + ppen )                           !
        4071             :        ! ----------------------------------------------------------------------!
        4072           0 :        do k = krel, kpen ! This is a layer index
        4073             :           ! ------------------------------------------------------------------ !
        4074             :           ! Calculate cumulus condensate at the upper interface of each layer. !
        4075             :           ! Note 'ppen < 0' and at 'k=kpen' layer, I used 'thlu_top'&'qtu_top' !
        4076             :           ! which explicitly considered zero or non-zero 'fer(kpen)'.          !
        4077             :           ! ------------------------------------------------------------------ !
        4078           0 :           if( k .eq. kpen ) then
        4079           0 :               call conden(ps0(k-1)+ppen,thlu_top,qtu_top,thj,qvj,qlj,qij,qse,id_check)
        4080             :           else
        4081           0 :               call conden(ps0(k),thlu(k),qtu(k),thj,qvj,qlj,qij,qse,id_check)
        4082             :           endif
        4083           0 :           if( id_check .eq. 1 ) then
        4084           0 :               exit_conden(i) = 1._r8
        4085           0 :               id_exit = .true.
        4086           0 :               go to 333
        4087             :           end if
        4088             :           ! ---------------------------------------------------------------- !
        4089             :           ! Calculate in-cloud mean LWC ( qlu(k) ), IWC ( qiu(k) ),  & layer !
        4090             :           ! mean cumulus fraction ( cufrc(k) ),  vertically-integrated layer !
        4091             :           ! mean LWP and IWP. Expel some of in-cloud condensate at the upper !
        4092             :           ! interface if it is largr than criqc. Note cumulus cloud fraction !
        4093             :           ! is assumed to be twice of core updraft fractional area. Thus LWP !
        4094             :           ! and IWP will be twice of actual value coming from our scheme.    !
        4095             :           ! ---------------------------------------------------------------- !
        4096           0 :           qcu(k)   = 0.5_r8 * ( qcubelow + qlj + qij )
        4097           0 :           qlu(k)   = 0.5_r8 * ( qlubelow + qlj )
        4098           0 :           qiu(k)   = 0.5_r8 * ( qiubelow + qij )
        4099           0 :           cufrc(k) = ( ufrc(k-1) + ufrc(k) )
        4100           0 :           if( k .eq. krel ) then
        4101           0 :               cufrc(k) = ( ufrclcl + ufrc(k) )*( prel - ps0(k) )/( ps0(k-1) - ps0(k) )
        4102           0 :           else if( k .eq. kpen ) then
        4103           0 :               cufrc(k) = ( ufrc(k-1) + 0._r8 )*( -ppen )        /( ps0(k-1) - ps0(k) )
        4104           0 :               if( (qlj + qij) .gt. criqc ) then
        4105           0 :                    qcu(k) = 0.5_r8 * ( qcubelow + criqc )
        4106           0 :                    qlu(k) = 0.5_r8 * ( qlubelow + criqc * qlj / ( qlj + qij ) )
        4107           0 :                    qiu(k) = 0.5_r8 * ( qiubelow + criqc * qij / ( qlj + qij ) )
        4108             :               endif
        4109             :           endif
        4110           0 :           rcwp = rcwp + ( qlu(k) + qiu(k) ) * ( ps0(k-1) - ps0(k) ) / g * cufrc(k)
        4111           0 :           rlwp = rlwp +   qlu(k)            * ( ps0(k-1) - ps0(k) ) / g * cufrc(k)
        4112           0 :           riwp = riwp +   qiu(k)            * ( ps0(k-1) - ps0(k) ) / g * cufrc(k)
        4113           0 :           qcubelow = qlj + qij
        4114           0 :           qlubelow = qlj
        4115           0 :           qiubelow = qij
        4116             :        end do
        4117             :        ! ------------------------------------ !
        4118             :        ! Cloud top and base interface indices !
        4119             :        ! ------------------------------------ !
        4120           0 :        cnt = real( kpen, r8 )
        4121           0 :        cnb = real( krel - 1, r8 )
        4122             :
        4123             :        ! ------------------------------------------------------------------------- !
        4124             :        ! End of formal calculation. Below blocks are for implicit CIN calculations !
        4125             :        ! with re-initialization and save variables at iter_cin = 1._r8             !
        4126             :        ! ------------------------------------------------------------------------- !
        4127             :
        4128             :        ! --------------------------------------------------------------- !
        4129             :        ! Adjust the original input profiles for implicit CIN calculation !
        4130             :        ! --------------------------------------------------------------- !
        4131             :
        4132           0 :        if( iter .ne. iter_cin ) then
        4133             :
        4134             :           ! ------------------------------------------------------------------- !
        4135             :           ! Save the output from "iter_cin = 1"                                 !
        4136             :           ! These output will be writed-out if "iter_cin = 1" was not performed !
        4137             :           ! for some reasons.                                                   !
        4138             :           ! ------------------------------------------------------------------- !
        4139             :
        4140           0 :           qv0_s(:mkx)           = qv0(:mkx) + qvten(:mkx) * dt
        4141           0 :           ql0_s(:mkx)           = ql0(:mkx) + qlten(:mkx) * dt
        4142           0 :           qi0_s(:mkx)           = qi0(:mkx) + qiten(:mkx) * dt
        4143           0 :           s0_s(:mkx)            = s0(:mkx)  +  sten(:mkx) * dt
        4144           0 :           u0_s(:mkx)            = u0(:mkx)  +  uten(:mkx) * dt
        4145           0 :           v0_s(:mkx)            = v0(:mkx)  +  vten(:mkx) * dt
        4146           0 :           qt0_s(:mkx)           = qv0_s(:mkx) + ql0_s(:mkx) + qi0_s(:mkx)
        4147           0 :           t0_s(:mkx)            = t0(:mkx)  +  sten(:mkx) * dt / cp
        4148           0 :           do m = 1, ncnst
        4149           0 :              tr0_s(:mkx,m)      = tr0(:mkx,m) + trten(:mkx,m) * dt
        4150             :           enddo
        4151             :
        4152           0 :           umf_s(0:mkx)          = umf(0:mkx)
        4153           0 :           qvten_s(:mkx)         = qvten(:mkx)
        4154           0 :           qlten_s(:mkx)         = qlten(:mkx)
        4155           0 :           qiten_s(:mkx)         = qiten(:mkx)
        4156           0 :           sten_s(:mkx)          = sten(:mkx)
        4157           0 :           uten_s(:mkx)          = uten(:mkx)
        4158           0 :           vten_s(:mkx)          = vten(:mkx)
        4159           0 :           qrten_s(:mkx)         = qrten(:mkx)
        4160           0 :           qsten_s(:mkx)         = qsten(:mkx)
        4161           0 :           precip_s              = precip
        4162           0 :           snow_s                = snow
        4163           0 :           evapc_s(:mkx)         = evapc(:mkx)
        4164           0 :           cush_s                = cush
        4165           0 :           cufrc_s(:mkx)         = cufrc(:mkx)
        4166           0 :           slflx_s(0:mkx)        = slflx(0:mkx)
        4167           0 :           qtflx_s(0:mkx)        = qtflx(0:mkx)
        4168           0 :           qcu_s(:mkx)           = qcu(:mkx)
        4169           0 :           qlu_s(:mkx)           = qlu(:mkx)
        4170           0 :           qiu_s(:mkx)           = qiu(:mkx)
        4171           0 :           fer_s(:mkx)           = fer(:mkx)
        4172           0 :           fdr_s(:mkx)           = fdr(:mkx)
        4173           0 :           cin_s                 = cin
        4174           0 :           cinlcl_s              = cinlcl
        4175           0 :           cbmf_s                = cbmf
        4176           0 :           rliq_s                = rliq
        4177           0 :           qc_s(:mkx)            = qc(:mkx)
        4178           0 :           cnt_s                 = cnt
        4179           0 :           cnb_s                 = cnb
        4180           0 :           qtten_s(:mkx)         = qtten(:mkx)
        4181           0 :           slten_s(:mkx)         = slten(:mkx)
        4182           0 :           ufrc_s(0:mkx)         = ufrc(0:mkx)
        4183             :
        4184           0 :           uflx_s(0:mkx)         = uflx(0:mkx)
        4185           0 :           vflx_s(0:mkx)         = vflx(0:mkx)
        4186             :
        4187           0 :           ufrcinvbase_s         = ufrcinvbase
        4188           0 :           ufrclcl_s             = ufrclcl
        4189           0 :           winvbase_s            = winvbase
        4190           0 :           wlcl_s                = wlcl
        4191           0 :           plcl_s                = plcl
        4192           0 :           pinv_s                = ps0(kinv-1)
        4193           0 :           plfc_s                = plfc
        4194           0 :           pbup_s                = ps0(kbup)
        4195           0 :           ppen_s                = ps0(kpen-1) + ppen
        4196           0 :           qtsrc_s               = qtsrc
        4197           0 :           thlsrc_s              = thlsrc
        4198           0 :           thvlsrc_s             = thvlsrc
        4199           0 :           emfkbup_s             = emf(kbup)
        4200           0 :           cbmflimit_s           = cbmflimit
        4201           0 :           tkeavg_s              = tkeavg
        4202           0 :           zinv_s                = zs0(kinv-1)
        4203           0 :           rcwp_s                = rcwp
        4204           0 :           rlwp_s                = rlwp
        4205           0 :           riwp_s                = riwp
        4206             :
        4207           0 :           wu_s(0:mkx)           = wu(0:mkx)
        4208           0 :           qtu_s(0:mkx)          = qtu(0:mkx)
        4209           0 :           thlu_s(0:mkx)         = thlu(0:mkx)
        4210           0 :           thvu_s(0:mkx)         = thvu(0:mkx)
        4211           0 :           uu_s(0:mkx)           = uu(0:mkx)
        4212           0 :           vu_s(0:mkx)           = vu(0:mkx)
        4213           0 :           qtu_emf_s(0:mkx)      = qtu_emf(0:mkx)
        4214           0 :           thlu_emf_s(0:mkx)     = thlu_emf(0:mkx)
        4215           0 :           uu_emf_s(0:mkx)       = uu_emf(0:mkx)
        4216           0 :           vu_emf_s(0:mkx)       = vu_emf(0:mkx)
        4217           0 :           uemf_s(0:mkx)         = uemf(0:mkx)
        4218             :
        4219           0 :           dwten_s(:mkx)         = dwten(:mkx)
        4220           0 :           diten_s(:mkx)         = diten(:mkx)
        4221           0 :           flxrain_s(0:mkx)      = flxrain(0:mkx)
        4222           0 :           flxsnow_s(0:mkx)      = flxsnow(0:mkx)
        4223           0 :           ntraprd_s(:mkx)       = ntraprd(:mkx)
        4224           0 :           ntsnprd_s(:mkx)       = ntsnprd(:mkx)
        4225             :
        4226           0 :           excessu_arr_s(:mkx)   = excessu_arr(:mkx)
        4227           0 :           excess0_arr_s(:mkx)   = excess0_arr(:mkx)
        4228           0 :           xc_arr_s(:mkx)        = xc_arr(:mkx)
        4229           0 :           aquad_arr_s(:mkx)     = aquad_arr(:mkx)
        4230           0 :           bquad_arr_s(:mkx)     = bquad_arr(:mkx)
        4231           0 :           cquad_arr_s(:mkx)     = cquad_arr(:mkx)
        4232           0 :           bogbot_arr_s(:mkx)    = bogbot_arr(:mkx)
        4233           0 :           bogtop_arr_s(:mkx)    = bogtop_arr(:mkx)
        4234             :
        4235           0 :           do m = 1, ncnst
        4236           0 :              trten_s(:mkx,m)    = trten(:mkx,m)
        4237           0 :              trflx_s(0:mkx,m)   = trflx(0:mkx,m)
        4238           0 :              tru_s(0:mkx,m)     = tru(0:mkx,m)
        4239           0 :              tru_emf_s(0:mkx,m) = tru_emf(0:mkx,m)
        4240             :           enddo
        4241             :
        4242             :           ! ----------------------------------------------------------------------------- !
        4243             :           ! Recalculate environmental variables for new cin calculation at "iter_cin = 2" !
        4244             :           ! using the updated state variables. Perform only for variables necessary  for  !
        4245             :           ! the new cin calculation.                                                      !
        4246             :           ! ----------------------------------------------------------------------------- !
        4247             :
        4248           0 :           qv0(:mkx)   = qv0_s(:mkx)
        4249           0 :           ql0(:mkx)   = ql0_s(:mkx)
        4250           0 :           qi0(:mkx)   = qi0_s(:mkx)
        4251           0 :           s0(:mkx)    = s0_s(:mkx)
        4252           0 :           t0(:mkx)    = t0_s(:mkx)
        4253             :
        4254           0 :           qt0(:mkx)   = (qv0(:mkx) + ql0(:mkx) + qi0(:mkx))
        4255           0 :           thl0(:mkx)  = (t0(:mkx) - xlv*ql0(:mkx)/cp - xls*qi0(:mkx)/cp)/exn0(:mkx)
        4256           0 :           thvl0(:mkx) = (1._r8 + zvir*qt0(:mkx))*thl0(:mkx)
        4257             :
        4258           0 :           ssthl0      = slope(mkx,thl0,p0) ! Dimension of ssthl0(:mkx) is implicit
        4259           0 :           ssqt0       = slope(mkx,qt0 ,p0)
        4260           0 :           ssu0        = slope(mkx,u0  ,p0)
        4261           0 :           ssv0        = slope(mkx,v0  ,p0)
        4262           0 :           do m = 1, ncnst
        4263           0 :              sstr0(:mkx,m) = slope(mkx,tr0(:mkx,m),p0)
        4264             :           enddo
        4265             :
        4266           0 :           do k = 1, mkx
        4267             :
        4268           0 :              thl0bot = thl0(k) + ssthl0(k) * ( ps0(k-1) - p0(k) )
        4269           0 :              qt0bot  = qt0(k)  + ssqt0(k)  * ( ps0(k-1) - p0(k) )
        4270           0 :              call conden(ps0(k-1),thl0bot,qt0bot,thj,qvj,qlj,qij,qse,id_check)
        4271           0 :              if( id_check .eq. 1 ) then
        4272           0 :                  exit_conden(i) = 1._r8
        4273           0 :                  id_exit = .true.
        4274           0 :                  go to 333
        4275             :              end if
        4276           0 :              thv0bot(k)  = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        4277           0 :              thvl0bot(k) = thl0bot * ( 1._r8 + zvir*qt0bot )
        4278             :
        4279           0 :              thl0top = thl0(k) + ssthl0(k) * ( ps0(k) - p0(k) )
        4280           0 :              qt0top  =  qt0(k) + ssqt0(k)  * ( ps0(k) - p0(k) )
        4281           0 :              call conden(ps0(k),thl0top,qt0top,thj,qvj,qlj,qij,qse,id_check)
        4282           0 :              if( id_check .eq. 1 ) then
        4283           0 :                  exit_conden(i) = 1._r8
        4284           0 :                  id_exit = .true.
        4285           0 :                  go to 333
        4286             :              end if
        4287           0 :              thv0top(k)  = thj * ( 1._r8 + zvir*qvj - qlj - qij )
        4288           0 :              thvl0top(k) = thl0top * ( 1._r8 + zvir*qt0top )
        4289             :
        4290             :           end do
        4291             :
        4292             :        endif               ! End of 'if(iter .ne. iter_cin)' if sentence.
        4293             :
        4294             :      end do                ! End of implicit CIN loop (cin_iter)
        4295             :
        4296             :      ! ----------------------- !
        4297             :      ! Update Output Variables !
        4298             :      ! ----------------------- !
        4299             :
        4300           0 :      umf_out(i,0:mkx)             = umf(0:mkx)
        4301           0 :      slflx_out(i,0:mkx)           = slflx(0:mkx)
        4302           0 :      qtflx_out(i,0:mkx)           = qtflx(0:mkx)
        4303             : !the indices are not reversed, these variables go into compute_mcshallow_inv, this is why they are called "flxprc1" and "flxsnow1".
        4304           0 :      flxprc1_out(i,0:mkx)         = flxrain(0:mkx) + flxsnow(0:mkx)
        4305           0 :      flxsnow1_out(i,0:mkx)        = flxsnow(0:mkx)
        4306           0 :      qvten_out(i,:mkx)            = qvten(:mkx)
        4307           0 :      qlten_out(i,:mkx)            = qlten(:mkx)
        4308           0 :      qiten_out(i,:mkx)            = qiten(:mkx)
        4309           0 :      sten_out(i,:mkx)             = sten(:mkx)
        4310           0 :      uten_out(i,:mkx)             = uten(:mkx)
        4311           0 :      vten_out(i,:mkx)             = vten(:mkx)
        4312           0 :      qrten_out(i,:mkx)            = qrten(:mkx)
        4313           0 :      qsten_out(i,:mkx)            = qsten(:mkx)
        4314           0 :      precip_out(i)                = precip
        4315           0 :      snow_out(i)                  = snow
        4316           0 :      evapc_out(i,:mkx)            = evapc(:mkx)
        4317           0 :      cufrc_out(i,:mkx)            = cufrc(:mkx)
        4318           0 :      qcu_out(i,:mkx)              = qcu(:mkx)
        4319           0 :      qlu_out(i,:mkx)              = qlu(:mkx)
        4320           0 :      qiu_out(i,:mkx)              = qiu(:mkx)
        4321           0 :      cush_inout(i)                = cush
        4322           0 :      cbmf_out(i)                  = cbmf
        4323           0 :      rliq_out(i)                  = rliq
        4324           0 :      qc_out(i,:mkx)               = qc(:mkx)
        4325           0 :      cnt_out(i)                   = cnt
        4326           0 :      cnb_out(i)                   = cnb
        4327             :
        4328           0 :      do m = 1, ncnst
        4329           0 :         trten_out(i,:mkx,m)       = trten(:mkx,m)
        4330             :      enddo
        4331             :
        4332             :      ! ------------------------------------------------- !
        4333             :      ! Below are specific diagnostic output for detailed !
        4334             :      ! analysis of cumulus scheme                        !
        4335             :      ! ------------------------------------------------- !
        4336             :
        4337           0 :      fer_out(i,mkx:1:-1)          = fer(:mkx)
        4338           0 :      fdr_out(i,mkx:1:-1)          = fdr(:mkx)
        4339           0 :      cinh_out(i)                  = cin
        4340           0 :      cinlclh_out(i)               = cinlcl
        4341           0 :      qtten_out(i,mkx:1:-1)        = qtten(:mkx)
        4342           0 :      slten_out(i,mkx:1:-1)        = slten(:mkx)
        4343           0 :      ufrc_out(i,mkx:0:-1)         = ufrc(0:mkx)
        4344           0 :      uflx_out(i,mkx:0:-1)         = uflx(0:mkx)
        4345           0 :      vflx_out(i,mkx:0:-1)         = vflx(0:mkx)
        4346             :
        4347           0 :      ufrcinvbase_out(i)           = ufrcinvbase
        4348           0 :      ufrclcl_out(i)               = ufrclcl
        4349           0 :      winvbase_out(i)              = winvbase
        4350           0 :      wlcl_out(i)                  = wlcl
        4351           0 :      plcl_out(i)                  = plcl
        4352           0 :      pinv_out(i)                  = ps0(kinv-1)
        4353           0 :      plfc_out(i)                  = plfc
        4354           0 :      pbup_out(i)                  = ps0(kbup)
        4355           0 :      ppen_out(i)                  = ps0(kpen-1) + ppen
        4356           0 :      qtsrc_out(i)                 = qtsrc
        4357           0 :      thlsrc_out(i)                = thlsrc
        4358           0 :      thvlsrc_out(i)               = thvlsrc
        4359           0 :      emfkbup_out(i)               = emf(kbup)
        4360           0 :      cbmflimit_out(i)             = cbmflimit
        4361           0 :      tkeavg_out(i)                = tkeavg
        4362           0 :      zinv_out(i)                  = zs0(kinv-1)
        4363           0 :      rcwp_out(i)                  = rcwp
        4364           0 :      rlwp_out(i)                  = rlwp
        4365           0 :      riwp_out(i)                  = riwp
        4366             :
        4367           0 :      wu_out(i,mkx:0:-1)           = wu(0:mkx)
        4368           0 :      qtu_out(i,mkx:0:-1)          = qtu(0:mkx)
        4369           0 :      thlu_out(i,mkx:0:-1)         = thlu(0:mkx)
        4370           0 :      thvu_out(i,mkx:0:-1)         = thvu(0:mkx)
        4371           0 :      uu_out(i,mkx:0:-1)           = uu(0:mkx)
        4372           0 :      vu_out(i,mkx:0:-1)           = vu(0:mkx)
        4373           0 :      qtu_emf_out(i,mkx:0:-1)      = qtu_emf(0:mkx)
        4374           0 :      thlu_emf_out(i,mkx:0:-1)     = thlu_emf(0:mkx)
        4375           0 :      uu_emf_out(i,mkx:0:-1)       = uu_emf(0:mkx)
        4376           0 :      vu_emf_out(i,mkx:0:-1)       = vu_emf(0:mkx)
        4377           0 :      uemf_out(i,mkx:0:-1)         = uemf(0:mkx)
        4378             :
        4379           0 :      dwten_out(i,mkx:1:-1)        = dwten(:mkx)
        4380           0 :      diten_out(i,mkx:1:-1)        = diten(:mkx)
        4381           0 :      flxrain_out(i,mkx:0:-1)      = flxrain(0:mkx)
        4382           0 :      flxsnow_out(i,mkx:0:-1)      = flxsnow(0:mkx)
        4383           0 :      ntraprd_out(i,mkx:1:-1)      = ntraprd(:mkx)
        4384           0 :      ntsnprd_out(i,mkx:1:-1)      = ntsnprd(:mkx)
        4385             :
        4386           0 :      excessu_arr_out(i,mkx:1:-1)  = excessu_arr(:mkx)
        4387           0 :      excess0_arr_out(i,mkx:1:-1)  = excess0_arr(:mkx)
        4388           0 :      xc_arr_out(i,mkx:1:-1)       = xc_arr(:mkx)
        4389           0 :      aquad_arr_out(i,mkx:1:-1)    = aquad_arr(:mkx)
        4390           0 :      bquad_arr_out(i,mkx:1:-1)    = bquad_arr(:mkx)
        4391           0 :      cquad_arr_out(i,mkx:1:-1)    = cquad_arr(:mkx)
        4392           0 :      bogbot_arr_out(i,mkx:1:-1)   = bogbot_arr(:mkx)
        4393           0 :      bogtop_arr_out(i,mkx:1:-1)   = bogtop_arr(:mkx)
        4394             :
        4395           0 :      do m = 1, ncnst
        4396           0 :         trflx_out(i,mkx:0:-1,m)   = trflx(0:mkx,m)
        4397           0 :         tru_out(i,mkx:0:-1,m)     = tru(0:mkx,m)
        4398           0 :         tru_emf_out(i,mkx:0:-1,m) = tru_emf(0:mkx,m)
        4399             :      enddo
        4400             :
        4401           0 :  333 if(id_exit) then ! Exit without cumulus convection
        4402             :
        4403           0 :      exit_UWCu(i) = 1._r8
        4404             :
        4405             :      ! --------------------------------------------------------------------- !
        4406             :      ! Initialize output variables when cumulus convection was not performed.!
        4407             :      ! --------------------------------------------------------------------- !
        4408             :
        4409           0 :      umf_out(i,0:mkx)             = 0._r8
        4410           0 :      slflx_out(i,0:mkx)           = 0._r8
        4411           0 :      qtflx_out(i,0:mkx)           = 0._r8
        4412           0 :      qvten_out(i,:mkx)            = 0._r8
        4413           0 :      qlten_out(i,:mkx)            = 0._r8
        4414           0 :      qiten_out(i,:mkx)            = 0._r8
        4415           0 :      sten_out(i,:mkx)             = 0._r8
        4416           0 :      uten_out(i,:mkx)             = 0._r8
        4417           0 :      vten_out(i,:mkx)             = 0._r8
        4418           0 :      qrten_out(i,:mkx)            = 0._r8
        4419           0 :      qsten_out(i,:mkx)            = 0._r8
        4420           0 :      precip_out(i)                = 0._r8
        4421           0 :      snow_out(i)                  = 0._r8
        4422           0 :      evapc_out(i,:mkx)            = 0._r8
        4423           0 :      cufrc_out(i,:mkx)            = 0._r8
        4424           0 :      qcu_out(i,:mkx)              = 0._r8
        4425           0 :      qlu_out(i,:mkx)              = 0._r8
        4426           0 :      qiu_out(i,:mkx)              = 0._r8
        4427           0 :      cush_inout(i)                = -1._r8
        4428           0 :      cbmf_out(i)                  = 0._r8
        4429           0 :      rliq_out(i)                  = 0._r8
        4430           0 :      qc_out(i,:mkx)               = 0._r8
        4431           0 :      cnt_out(i)                   = 1._r8
        4432           0 :      cnb_out(i)                   = real(mkx, r8)
        4433             :
        4434           0 :      fer_out(i,mkx:1:-1)          = 0._r8
        4435           0 :      fdr_out(i,mkx:1:-1)          = 0._r8
        4436           0 :      cinh_out(i)                  = -1._r8
        4437           0 :      cinlclh_out(i)               = -1._r8
        4438           0 :      qtten_out(i,mkx:1:-1)        = 0._r8
        4439           0 :      slten_out(i,mkx:1:-1)        = 0._r8
        4440           0 :      ufrc_out(i,mkx:0:-1)         = 0._r8
        4441           0 :      uflx_out(i,mkx:0:-1)         = 0._r8
        4442           0 :      vflx_out(i,mkx:0:-1)         = 0._r8
        4443             :
        4444           0 :      ufrcinvbase_out(i)           = 0._r8
        4445           0 :      ufrclcl_out(i)               = 0._r8
        4446           0 :      winvbase_out(i)              = 0._r8
        4447           0 :      wlcl_out(i)                  = 0._r8
        4448           0 :      plcl_out(i)                  = 0._r8
        4449           0 :      pinv_out(i)                  = 0._r8
        4450           0 :      plfc_out(i)                  = 0._r8
        4451           0 :      pbup_out(i)                  = 0._r8
        4452           0 :      ppen_out(i)                  = 0._r8
        4453           0 :      qtsrc_out(i)                 = 0._r8
        4454           0 :      thlsrc_out(i)                = 0._r8
        4455           0 :      thvlsrc_out(i)               = 0._r8
        4456           0 :      emfkbup_out(i)               = 0._r8
        4457           0 :      cbmflimit_out(i)             = 0._r8
        4458           0 :      tkeavg_out(i)                = 0._r8
        4459           0 :      zinv_out(i)                  = 0._r8
        4460           0 :      rcwp_out(i)                  = 0._r8
        4461           0 :      rlwp_out(i)                  = 0._r8
        4462           0 :      riwp_out(i)                  = 0._r8
        4463             :
        4464           0 :      wu_out(i,mkx:0:-1)           = 0._r8
        4465           0 :      qtu_out(i,mkx:0:-1)          = 0._r8
        4466           0 :      thlu_out(i,mkx:0:-1)         = 0._r8
        4467           0 :      thvu_out(i,mkx:0:-1)         = 0._r8
        4468           0 :      uu_out(i,mkx:0:-1)           = 0._r8
        4469           0 :      vu_out(i,mkx:0:-1)           = 0._r8
        4470           0 :      qtu_emf_out(i,mkx:0:-1)      = 0._r8
        4471           0 :      thlu_emf_out(i,mkx:0:-1)     = 0._r8
        4472           0 :      uu_emf_out(i,mkx:0:-1)       = 0._r8
        4473           0 :      vu_emf_out(i,mkx:0:-1)       = 0._r8
        4474           0 :      uemf_out(i,mkx:0:-1)         = 0._r8
        4475             :
        4476           0 :      dwten_out(i,mkx:1:-1)        = 0._r8
        4477           0 :      diten_out(i,mkx:1:-1)        = 0._r8
        4478           0 :      flxrain_out(i,mkx:0:-1)      = 0._r8
        4479           0 :      flxsnow_out(i,mkx:0:-1)      = 0._r8
        4480           0 :      ntraprd_out(i,mkx:1:-1)      = 0._r8
        4481           0 :      ntsnprd_out(i,mkx:1:-1)      = 0._r8
        4482             :
        4483           0 :      excessu_arr_out(i,mkx:1:-1)  = 0._r8
        4484           0 :      excess0_arr_out(i,mkx:1:-1)  = 0._r8
        4485           0 :      xc_arr_out(i,mkx:1:-1)       = 0._r8
        4486           0 :      aquad_arr_out(i,mkx:1:-1)    = 0._r8
        4487           0 :      bquad_arr_out(i,mkx:1:-1)    = 0._r8
        4488           0 :      cquad_arr_out(i,mkx:1:-1)    = 0._r8
        4489           0 :      bogbot_arr_out(i,mkx:1:-1)   = 0._r8
        4490           0 :      bogtop_arr_out(i,mkx:1:-1)   = 0._r8
        4491             :
        4492           0 :      do m = 1, ncnst
        4493           0 :         trten_out(i,:mkx,m)       = 0._r8
        4494           0 :         trflx_out(i,mkx:0:-1,m)   = 0._r8
        4495           0 :         tru_out(i,mkx:0:-1,m)     = 0._r8
        4496           0 :         tru_emf_out(i,mkx:0:-1,m) = 0._r8
        4497             :      enddo
        4498             :
        4499             :      end if
        4500             :
        4501             :      end do                  ! end of big i loop for each column.
        4502             :
        4503             :      ! ---------------------------------------- !
        4504             :      ! Writing main diagnostic output variables !
        4505             :      ! ---------------------------------------- !
        4506             :
        4507           0 :      call outfld( 'qtflx_Cu'        , qtflx_out(:,mkx:0:-1),    mix,    lchnk )
        4508           0 :      call outfld( 'slflx_Cu'        , slflx_out(:,mkx:0:-1),    mix,    lchnk )
        4509           0 :      call outfld( 'uflx_Cu'         , uflx_out,                 mix,    lchnk )
        4510           0 :      call outfld( 'vflx_Cu'         , vflx_out,                 mix,    lchnk )
        4511             :
        4512           0 :      call outfld( 'qtten_Cu'        , qtten_out,                mix,    lchnk )
        4513           0 :      call outfld( 'slten_Cu'        , slten_out,                mix,    lchnk )
        4514           0 :      call outfld( 'uten_Cu'         , uten_out(:,mkx:1:-1),     mix,    lchnk )
        4515           0 :      call outfld( 'vten_Cu'         , vten_out(:,mkx:1:-1),     mix,    lchnk )
        4516           0 :      call outfld( 'qvten_Cu'        , qvten_out(:,mkx:1:-1),    mix,    lchnk )
        4517           0 :      call outfld( 'qlten_Cu'        , qlten_out(:,mkx:1:-1),    mix,    lchnk )
        4518           0 :      call outfld( 'qiten_Cu'        , qiten_out(:,mkx:1:-1),    mix,    lchnk )
        4519             :
        4520           0 :      call outfld( 'cbmf_Cu'         , cbmf_out,                 mix,    lchnk )
        4521           0 :      call outfld( 'ufrcinvbase_Cu'  , ufrcinvbase_out,          mix,    lchnk )
        4522           0 :      call outfld( 'ufrclcl_Cu'      , ufrclcl_out,              mix,    lchnk )
        4523           0 :      call outfld( 'winvbase_Cu'     , winvbase_out,             mix,    lchnk )
        4524           0 :      call outfld( 'wlcl_Cu'         , wlcl_out,                 mix,    lchnk )
        4525           0 :      call outfld( 'plcl_Cu'         , plcl_out,                 mix,    lchnk )
        4526           0 :      call outfld( 'pinv_Cu'         , pinv_out,                 mix,    lchnk )
        4527           0 :      call outfld( 'plfc_Cu'         , plfc_out,                 mix,    lchnk )
        4528           0 :      call outfld( 'pbup_Cu'         , pbup_out,                 mix,    lchnk )
        4529           0 :      call outfld( 'ppen_Cu'         , ppen_out,                 mix,    lchnk )
        4530           0 :      call outfld( 'qtsrc_Cu'        , qtsrc_out,                mix,    lchnk )
        4531           0 :      call outfld( 'thlsrc_Cu'       , thlsrc_out,               mix,    lchnk )
        4532           0 :      call outfld( 'thvlsrc_Cu'      , thvlsrc_out,              mix,    lchnk )
        4533           0 :      call outfld( 'emfkbup_Cu'      , emfkbup_out,              mix,    lchnk )
        4534           0 :      call outfld( 'cin_Cu'          , cinh_out,                 mix,    lchnk )
        4535           0 :      call outfld( 'cinlcl_Cu'       , cinlclh_out,              mix,    lchnk )
        4536           0 :      call outfld( 'cbmflimit_Cu'    , cbmflimit_out,            mix,    lchnk )
        4537           0 :      call outfld( 'tkeavg_Cu'       , tkeavg_out,               mix,    lchnk )
        4538           0 :      call outfld( 'zinv_Cu'         , zinv_out,                 mix,    lchnk )
        4539           0 :      call outfld( 'rcwp_Cu'         , rcwp_out,                 mix,    lchnk )
        4540           0 :      call outfld( 'rlwp_Cu'         , rlwp_out,                 mix,    lchnk )
        4541           0 :      call outfld( 'riwp_Cu'         , riwp_out,                 mix,    lchnk )
        4542           0 :      call outfld( 'tophgt_Cu'       , cush_inout,               mix,    lchnk )
        4543             :
        4544           0 :      call outfld( 'wu_Cu'           , wu_out,                   mix,    lchnk )
        4545           0 :      call outfld( 'ufrc_Cu'         , ufrc_out,                 mix,    lchnk )
        4546           0 :      call outfld( 'qtu_Cu'          , qtu_out,                  mix,    lchnk )
        4547           0 :      call outfld( 'thlu_Cu'         , thlu_out,                 mix,    lchnk )
        4548           0 :      call outfld( 'thvu_Cu'         , thvu_out,                 mix,    lchnk )
        4549           0 :      call outfld( 'uu_Cu'           , uu_out,                   mix,    lchnk )
        4550           0 :      call outfld( 'vu_Cu'           , vu_out,                   mix,    lchnk )
        4551           0 :      call outfld( 'qtu_emf_Cu'      , qtu_emf_out,              mix,    lchnk )
        4552           0 :      call outfld( 'thlu_emf_Cu'     , thlu_emf_out,             mix,    lchnk )
        4553           0 :      call outfld( 'uu_emf_Cu'       , uu_emf_out,               mix,    lchnk )
        4554           0 :      call outfld( 'vu_emf_Cu'       , vu_emf_out,               mix,    lchnk )
        4555           0 :      call outfld( 'umf_Cu'          , umf_out(:,mkx:0:-1),      mix,    lchnk )
        4556           0 :      call outfld( 'uemf_Cu'         , uemf_out,                 mix,    lchnk )
        4557           0 :      call outfld( 'qcu_Cu'          , qcu_out(:,mkx:1:-1),      mix,    lchnk )
        4558           0 :      call outfld( 'qlu_Cu'          , qlu_out(:,mkx:1:-1),      mix,    lchnk )
        4559           0 :      call outfld( 'qiu_Cu'          , qiu_out(:,mkx:1:-1),      mix,    lchnk )
        4560           0 :      call outfld( 'cufrc_Cu'        , cufrc_out(:,mkx:1:-1),    mix,    lchnk )
        4561           0 :      call outfld( 'fer_Cu'          , fer_out,                  mix,    lchnk )
        4562           0 :      call outfld( 'fdr_Cu'          , fdr_out,                  mix,    lchnk )
        4563             :
        4564           0 :      call outfld( 'dwten_Cu'        , dwten_out,                mix,    lchnk )
        4565           0 :      call outfld( 'diten_Cu'        , diten_out,                mix,    lchnk )
        4566           0 :      call outfld( 'qrten_Cu'        , qrten_out(:,mkx:1:-1),    mix,    lchnk )
        4567           0 :      call outfld( 'qsten_Cu'        , qsten_out(:,mkx:1:-1),    mix,    lchnk )
        4568           0 :      call outfld( 'flxrain_Cu'      , flxrain_out,              mix,    lchnk )
        4569           0 :      call outfld( 'flxsnow_Cu'      , flxsnow_out,              mix,    lchnk )
        4570           0 :      call outfld( 'ntraprd_Cu'      , ntraprd_out,              mix,    lchnk )
        4571           0 :      call outfld( 'ntsnprd_Cu'      , ntsnprd_out,              mix,    lchnk )
        4572             :
        4573           0 :      call outfld( 'excessu_Cu'      , excessu_arr_out,          mix,    lchnk )
        4574           0 :      call outfld( 'excess0_Cu'      , excess0_arr_out,          mix,    lchnk )
        4575           0 :      call outfld( 'xc_Cu'           , xc_arr_out,               mix,    lchnk )
        4576           0 :      call outfld( 'aquad_Cu'        , aquad_arr_out,            mix,    lchnk )
        4577           0 :      call outfld( 'bquad_Cu'        , bquad_arr_out,            mix,    lchnk )
        4578           0 :      call outfld( 'cquad_Cu'        , cquad_arr_out,            mix,    lchnk )
        4579           0 :      call outfld( 'bogbot_Cu'       , bogbot_arr_out,           mix,    lchnk )
        4580           0 :      call outfld( 'bogtop_Cu'       , bogtop_arr_out,           mix,    lchnk )
        4581             :
        4582           0 :      call outfld( 'exit_UWCu_Cu'    , exit_UWCu,                mix,    lchnk )
        4583           0 :      call outfld( 'exit_conden_Cu'  , exit_conden,              mix,    lchnk )
        4584           0 :      call outfld( 'exit_klclmkx_Cu' , exit_klclmkx,             mix,    lchnk )
        4585           0 :      call outfld( 'exit_klfcmkx_Cu' , exit_klfcmkx,             mix,    lchnk )
        4586           0 :      call outfld( 'exit_ufrc_Cu'    , exit_ufrc,                mix,    lchnk )
        4587           0 :      call outfld( 'exit_wtw_Cu'     , exit_wtw,                 mix,    lchnk )
        4588           0 :      call outfld( 'exit_drycore_Cu' , exit_drycore,             mix,    lchnk )
        4589           0 :      call outfld( 'exit_wu_Cu'      , exit_wu,                  mix,    lchnk )
        4590           0 :      call outfld( 'exit_cufilter_Cu', exit_cufilter,            mix,    lchnk )
        4591           0 :      call outfld( 'exit_kinv1_Cu'   , exit_kinv1,               mix,    lchnk )
        4592           0 :      call outfld( 'exit_rei_Cu'     , exit_rei,                 mix,    lchnk )
        4593             :
        4594           0 :      call outfld( 'limit_shcu_Cu'   , limit_shcu,               mix,    lchnk )
        4595           0 :      call outfld( 'limit_negcon_Cu' , limit_negcon,             mix,    lchnk )
        4596           0 :      call outfld( 'limit_ufrc_Cu'   , limit_ufrc,               mix,    lchnk )
        4597           0 :      call outfld( 'limit_ppen_Cu'   , limit_ppen,               mix,    lchnk )
        4598           0 :      call outfld( 'limit_emf_Cu'    , limit_emf,                mix,    lchnk )
        4599           0 :      call outfld( 'limit_cinlcl_Cu' , limit_cinlcl,             mix,    lchnk )
        4600           0 :      call outfld( 'limit_cin_Cu'    , limit_cin,                mix,    lchnk )
        4601           0 :      call outfld( 'limit_cbmf_Cu'   , limit_cbmf,               mix,    lchnk )
        4602           0 :      call outfld( 'limit_rei_Cu'    , limit_rei,                mix,    lchnk )
        4603           0 :      call outfld( 'ind_delcin_Cu'   , ind_delcin,               mix,    lchnk )
        4604             :
        4605           0 :     return
        4606             :
        4607           0 :   end subroutine compute_uwshcu
        4608             :
        4609             :   ! ------------------------------ !
        4610             :   !                                !
        4611             :   ! Beginning of subroutine blocks !
        4612             :   !                                !
        4613             :   ! ------------------------------ !
        4614             :
        4615           0 :   subroutine getbuoy(pbot,thv0bot,ptop,thv0top,thvubot,thvutop,plfc,cin)
        4616             :   ! ----------------------------------------------------------- !
        4617             :   ! Subroutine to calculate integrated CIN [ J/kg = m2/s2 ] and !
        4618             :   ! 'cinlcl, plfc' if any. Assume 'thv' is linear in each layer !
        4619             :   ! both for cumulus and environment. Note that this subroutine !
        4620             :   ! only include positive CIN in calculation - if there are any !
        4621             :   ! negative CIN, it is assumed to be zero.    This is slightly !
        4622             :   ! different from 'single_cin' below, where both positive  and !
        4623             :   ! negative CIN are included.                                  !
        4624             :   ! ----------------------------------------------------------- !
        4625             :     real(r8) pbot,thv0bot,ptop,thv0top,thvubot,thvutop,plfc,cin,frc
        4626             :
        4627           0 :     if( thvubot .gt. thv0bot .and. thvutop .gt. thv0top ) then
        4628           0 :         plfc = pbot
        4629           0 :         return
        4630           0 :     elseif( thvubot .le. thv0bot .and. thvutop .le. thv0top ) then
        4631             :         cin  = cin - ( (thvubot/thv0bot - 1._r8) + (thvutop/thv0top - 1._r8)) * (pbot - ptop) /        &
        4632           0 :                      ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) )
        4633           0 :     elseif( thvubot .gt. thv0bot .and. thvutop .le. thv0top ) then
        4634           0 :         frc  = ( thvutop/thv0top - 1._r8 ) / ( (thvutop/thv0top - 1._r8) - (thvubot/thv0bot - 1._r8) )
        4635             :         cin  = cin - ( thvutop/thv0top - 1._r8 ) * ( (ptop + frc*(pbot - ptop)) - ptop ) /             &
        4636           0 :                      ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) )
        4637             :     else
        4638           0 :         frc  = ( thvubot/thv0bot - 1._r8 ) / ( (thvubot/thv0bot - 1._r8) - (thvutop/thv0top - 1._r8) )
        4639           0 :         plfc = pbot - frc * ( pbot - ptop )
        4640             :         cin  = cin - ( thvubot/thv0bot - 1._r8)*(pbot - plfc)/                                         &
        4641           0 :                      ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top * exnf(ptop)))
        4642             :     endif
        4643             :
        4644             :     return
        4645           0 :   end subroutine getbuoy
        4646             :
        4647           0 :   function single_cin(pbot,thv0bot,ptop,thv0top,thvubot,thvutop)
        4648             :   ! ------------------------------------------------------- !
        4649             :   ! Function to calculate a single layer CIN by summing all !
        4650             :   ! positive and negative CIN.                              !
        4651             :   ! ------------------------------------------------------- !
        4652             :     real(r8) :: single_cin
        4653             :     real(r8)    pbot,thv0bot,ptop,thv0top,thvubot,thvutop
        4654             :
        4655             :     single_cin = ( (1._r8 - thvubot/thv0bot) + (1._r8 - thvutop/thv0top)) * ( pbot - ptop ) / &
        4656           0 :                  ( pbot/(r*thv0bot*exnf(pbot)) + ptop/(r*thv0top*exnf(ptop)) )
        4657             :     return
        4658             :   end function single_cin
        4659             :
        4660             :
        4661           0 :   subroutine conden(p,thl,qt,th,qv,ql,qi,rvls,id_check)
        4662             :   ! --------------------------------------------------------------------- !
        4663             :   ! Calculate thermodynamic properties from a given set of ( p, thl, qt ) !
        4664             :   ! --------------------------------------------------------------------- !
        4665             :     implicit none
        4666             :     real(r8), intent(in)  :: p
        4667             :     real(r8), intent(in)  :: thl
        4668             :     real(r8), intent(in)  :: qt
        4669             :     real(r8), intent(out) :: th
        4670             :     real(r8), intent(out) :: qv
        4671             :     real(r8), intent(out) :: ql
        4672             :     real(r8), intent(out) :: qi
        4673             :     real(r8), intent(out) :: rvls
        4674             :     integer , intent(out) :: id_check
        4675             :     real(r8)              :: tc,temps,t
        4676             :     real(r8)              :: leff, nu, qc
        4677             :     integer               :: iteration
        4678             :     real(r8)              :: es              ! Saturation vapor pressure
        4679             :     real(r8)              :: qs              ! Saturation spec. humidity
        4680             :
        4681             :
        4682           0 :     tc   = thl*exnf(p)
        4683             :   ! Modification : In order to be compatible with the dlf treatment in stratiform.F90,
        4684             :   !                we may use ( 268.15, 238.15 ) with 30K ramping instead of 20 K,
        4685             :   !                in computing ice fraction below.
        4686             :   !                Note that 'cldfrc_fice' uses ( 243.15, 263.15 ) with 20K ramping for stratus.
        4687           0 :     nu   = max(min((268._r8 - tc)/20._r8,1.0_r8),0.0_r8)  ! Fraction of ice in the condensate.
        4688           0 :     leff = (1._r8 - nu)*xlv + nu*xls                      ! This is an estimate that hopefully speeds convergence
        4689             :
        4690             :     ! --------------------------------------------------------------------------- !
        4691             :     ! Below "temps" and "rvls" are just initial guesses for iteration loop below. !
        4692             :     ! Note that the output "temps" from the below iteration loop is "temperature" !
        4693             :     ! NOT "liquid temperature".                                                   !
        4694             :     ! --------------------------------------------------------------------------- !
        4695             :
        4696           0 :     temps  = tc
        4697           0 :     call qsat(temps, p, es, qs)
        4698           0 :     rvls   = qs
        4699             :
        4700           0 :     if( qs .ge. qt ) then
        4701           0 :         id_check = 0
        4702           0 :         qv = qt
        4703           0 :         qc = 0._r8
        4704           0 :         ql = 0._r8
        4705           0 :         qi = 0._r8
        4706           0 :         th = tc/exnf(p)
        4707             :     else
        4708           0 :         do iteration = 1, 10
        4709           0 :            temps  = temps + ( (tc-temps)*cp/leff + qt - rvls )/( cp/leff + ep2*leff*rvls/r/temps/temps )
        4710           0 :            call qsat(temps, p, es, qs)
        4711           0 :            rvls   = qs
        4712             :         end do
        4713           0 :         qc = max(qt - qs,0._r8)
        4714           0 :         qv = qt - qc
        4715           0 :         ql = qc*(1._r8 - nu)
        4716           0 :         qi = nu*qc
        4717           0 :         th = temps/exnf(p)
        4718           0 :         if( abs((temps-(leff/cp)*qc)-tc) .ge. 1._r8 ) then
        4719           0 :             id_check = 1
        4720             :         else
        4721           0 :             id_check = 0
        4722             :         end if
        4723             :     end if
        4724             :
        4725           0 :     return
        4726             :   end subroutine conden
        4727             :
        4728           0 :   subroutine roots(a,b,c,r1,r2,status)
        4729             :   ! --------------------------------------------------------- !
        4730             :   ! Subroutine to solve the second order polynomial equation. !
        4731             :   ! I should check this subroutine later.                     !
        4732             :   ! --------------------------------------------------------- !
        4733             :     real(r8), intent(in)  :: a
        4734             :     real(r8), intent(in)  :: b
        4735             :     real(r8), intent(in)  :: c
        4736             :     real(r8), intent(out) :: r1
        4737             :     real(r8), intent(out) :: r2
        4738             :     integer , intent(out) :: status
        4739             :     real(r8)              :: q
        4740             :
        4741           0 :     status = 0
        4742             :
        4743           0 :     if( a .eq. 0._r8 ) then                            ! Form b*x + c = 0
        4744           0 :         if( b .eq. 0._r8 ) then                        ! Failure: c = 0
        4745           0 :             status = 1
        4746             :         else                                           ! b*x + c = 0
        4747           0 :             r1 = -c/b
        4748             :         endif
        4749           0 :         r2 = r1
        4750             :     else
        4751           0 :         if( b .eq. 0._r8 ) then                        ! Form a*x**2 + c = 0
        4752           0 :             if( a*c .gt. 0._r8 ) then                  ! Failure: x**2 = -c/a < 0
        4753           0 :                 status = 2
        4754             :             else                                       ! x**2 = -c/a
        4755           0 :                 r1 = sqrt(-c/a)
        4756             :             endif
        4757           0 :             r2 = -r1
        4758             :        else                                            ! Form a*x**2 + b*x + c = 0
        4759           0 :             if( (b**2 - 4._r8*a*c) .lt. 0._r8 ) then   ! Failure, no real roots
        4760           0 :                  status = 3
        4761             :             else
        4762           0 :                  q  = -0.5_r8*(b + sign(1.0_r8,b)*sqrt(b**2 - 4._r8*a*c))
        4763           0 :                  r1 =  q/a
        4764           0 :                  r2 =  c/q
        4765             :             endif
        4766             :        endif
        4767             :     endif
        4768             :
        4769           0 :     return
        4770             :   end subroutine roots
        4771             :
        4772           0 :   function slope(mkx,field,p0)
        4773             :   ! ------------------------------------------------------------------ !
        4774             :   ! Function performing profile reconstruction of conservative scalars !
        4775             :   ! in each layer. This is identical to profile reconstruction used in !
        4776             :   ! UW-PBL scheme but from bottom to top layer here.     At the lowest !
        4777             :   ! layer near to surface, slope is defined using the two lowest layer !
        4778             :   ! mid-point values. I checked this subroutine and it is correct.     !
        4779             :   ! ------------------------------------------------------------------ !
        4780             :     integer,  intent(in) :: mkx
        4781             :     real(r8)             :: slope(mkx)
        4782             :     real(r8), intent(in) :: field(mkx)
        4783             :     real(r8), intent(in) :: p0(mkx)
        4784             :
        4785             :     real(r8)             :: below
        4786             :     real(r8)             :: above
        4787             :     integer              :: k
        4788             :
        4789           0 :     below = ( field(2) - field(1) ) / ( p0(2) - p0(1) )
        4790           0 :     do k = 2, mkx
        4791           0 :        above = ( field(k) - field(k-1) ) / ( p0(k) - p0(k-1) )
        4792           0 :        if( above .gt. 0._r8 ) then
        4793           0 :            slope(k-1) = max(0._r8,min(above,below))
        4794             :        else
        4795           0 :            slope(k-1) = min(0._r8,max(above,below))
        4796             :        end if
        4797           0 :        below = above
        4798             :     end do
        4799           0 :     slope(mkx) = slope(mkx-1)
        4800             :
        4801           0 :     return
        4802             :   end function slope
        4803             :
        4804           0 :   function qsinvert(qt,thl,psfc)
        4805             :   ! ----------------------------------------------------------------- !
        4806             :   ! Function calculating saturation pressure ps (or pLCL) from qt and !
        4807             :   ! thl ( liquid potential temperature,  NOT liquid virtual potential !
        4808             :   ! temperature) by inverting Bolton formula. I should check later if !
        4809             :   ! current use of 'leff' instead of 'xlv' here is reasonable or not. !
        4810             :   ! ----------------------------------------------------------------- !
        4811             :     real(r8)          :: qsinvert
        4812             :     real(r8)             qt, thl, psfc
        4813             :     real(r8)             ps, Pis, Ts, err, dlnqsdT, dTdPis
        4814             :     real(r8)             dPisdps, dlnqsdps, derrdps, dps
        4815             :     real(r8)             Ti, rhi, TLCL, PiLCL, psmin, dpsmax
        4816             :     integer              i
        4817             :     real(r8)          :: es                     ! saturation vapor pressure
        4818             :     real(r8)          :: qs                     ! saturation spec. humidity
        4819             :     real(r8)          :: gam                    ! (L/cp)*dqs/dT
        4820             :     real(r8)          :: leff, nu
        4821             :
        4822           0 :     psmin  = 100._r8*100._r8 ! Default saturation pressure [Pa] if iteration does not converge
        4823           0 :     dpsmax = 1._r8           ! Tolerance [Pa] for convergence of iteration
        4824             :
        4825             :     ! ------------------------------------ !
        4826             :     ! Calculate best initial guess of pLCL !
        4827             :     ! ------------------------------------ !
        4828             :
        4829           0 :     Ti       =  thl*(psfc/p00)**rovcp
        4830           0 :     call qsat(Ti, psfc, es, qs)
        4831           0 :     rhi      =  qt/qs
        4832           0 :     if( rhi .le. 0.01_r8 ) then
        4833           0 :         write(iulog,*) 'Source air is too dry and pLCL is set to psmin in uwshcu.F90'
        4834           0 :         qsinvert = psmin
        4835           0 :         return
        4836             :     end if
        4837           0 :     TLCL     =  55._r8 + 1._r8/(1._r8/(Ti-55._r8)-log(rhi)/2840._r8); ! Bolton's formula. MWR.1980.Eq.(22)
        4838           0 :     PiLCL    =  TLCL/thl
        4839           0 :     ps       =  p00*(PiLCL)**(1._r8/rovcp)
        4840             :
        4841           0 :     do i = 1, 10
        4842           0 :        Pis      =  (ps/p00)**rovcp
        4843           0 :        Ts       =  thl*Pis
        4844           0 :        call qsat(Ts, ps, es, qs, gam=gam)
        4845           0 :        err      =  qt - qs
        4846           0 :        nu       =  max(min((268._r8 - Ts)/20._r8,1.0_r8),0.0_r8)
        4847           0 :        leff     =  (1._r8 - nu)*xlv + nu*xls
        4848           0 :        dlnqsdT  =  gam*(cp/leff)/qs
        4849           0 :        dTdPis   =  thl
        4850           0 :        dPisdps  =  rovcp*Pis/ps
        4851           0 :        dlnqsdps = -1._r8/(ps - (1._r8 - ep2)*es)
        4852           0 :        derrdps  = -qs*(dlnqsdT * dTdPis * dPisdps + dlnqsdps)
        4853           0 :        dps      = -err/derrdps
        4854           0 :        ps       =  ps + dps
        4855           0 :        if( ps .lt. 0._r8 ) then
        4856           0 :            write(iulog,*) 'pLCL iteration is negative and set to psmin in uwshcu.F90', qt, thl, psfc
        4857           0 :            qsinvert = psmin
        4858           0 :            return
        4859             :        end if
        4860           0 :        if( abs(dps) .le. dpsmax ) then
        4861           0 :            qsinvert = ps
        4862             :            return
        4863             :        end if
        4864             :     end do
        4865           0 :     write(iulog,*) 'pLCL does not converge and is set to psmin in uwshcu.F90', qt, thl, psfc
        4866           0 :     qsinvert = psmin
        4867           0 :     return
        4868             :   end function qsinvert
        4869             :
        4870           0 :   real(r8) function compute_alpha(del_CIN,ke)
        4871             :   ! ------------------------------------------------ !
        4872             :   ! Subroutine to compute proportionality factor for !
        4873             :   ! implicit CIN calculation.                        !
        4874             :   ! ------------------------------------------------ !
        4875             :     real(r8) :: del_CIN, ke
        4876             :     real(r8) :: x0, x1
        4877             :
        4878             :     integer  :: iteration
        4879             :
        4880           0 :     x0 = 0._r8
        4881           0 :     do iteration = 1, 10
        4882           0 :        x1 = x0 - (exp(-x0*ke*del_CIN) - x0)/(-ke*del_CIN*exp(-x0*ke*del_CIN) - 1._r8)
        4883           0 :        x0 = x1
        4884             :     end do
        4885           0 :     compute_alpha = x0
        4886             :
        4887             :     return
        4888             :
        4889             :   end function compute_alpha
        4890             :
        4891           0 :   real(r8) function compute_mumin2(mulcl,rmaxfrac,mulow)
        4892             :   ! --------------------------------------------------------- !
        4893             :   ! Subroutine to compute critical 'mu' (normalized CIN) such !
        4894             :   ! that updraft fraction at the LCL is equal to 'rmaxfrac'.  !
        4895             :   ! --------------------------------------------------------- !
        4896             :     real(r8) :: mulcl, rmaxfrac, mulow
        4897             :     real(r8) :: x0, x1, ex, ef, exf, f, fs
        4898             :     integer  :: iteration
        4899             :
        4900           0 :     x0 = mulow
        4901           0 :     do iteration = 1, 10
        4902           0 :        ex = exp(-x0**2)
        4903           0 :        ef = erfc(x0)
        4904             :        ! if(x0.ge.3._r8) then
        4905             :        !    compute_mumin2 = 3._r8
        4906             :        !    goto 20
        4907             :        ! endif
        4908           0 :        exf = ex/ef
        4909           0 :        f  = 0.5_r8*exf**2 - 0.5_r8*(ex/2._r8/rmaxfrac)**2 - (mulcl*2.5066_r8/2._r8)**2
        4910           0 :        fs = (2._r8*exf**2)*(exf/sqrt(3.141592_r8)-x0) + (0.5_r8*x0*ex**2)/(rmaxfrac**2)
        4911           0 :        x1 = x0 - f/fs
        4912           0 :        x0 = x1
        4913             :     end do
        4914           0 :     compute_mumin2 = x0
        4915             :
        4916             :  20 return
        4917             :
        4918             :   end function compute_mumin2
        4919             :
        4920           0 :   real(r8) function compute_ppen(wtwb,D,bogbot,bogtop,rho0j,dpen)
        4921             :   ! ----------------------------------------------------------- !
        4922             :   ! Subroutine to compute critical 'ppen[Pa]<0' ( pressure dis. !
        4923             :   ! from 'ps0(kpen-1)' to the cumulus top where cumulus updraft !
        4924             :   ! vertical velocity is exactly zero ) by considering exact    !
        4925             :   ! non-zero fer(kpen).                                         !
        4926             :   ! ----------------------------------------------------------- !
        4927             :     real(r8) :: wtwb, D, bogbot, bogtop, rho0j, dpen
        4928             :     real(r8) :: x0, x1, f, fs, SB, s00
        4929             :     integer  :: iteration
        4930             :
        4931             :     ! Buoyancy slope
        4932           0 :       SB = ( bogtop - bogbot ) / dpen
        4933             :     ! Sign of slope, 'f' at x = 0
        4934             :     ! If 's00>0', 'w' increases with height.
        4935           0 :       s00 = bogbot / rho0j - D * wtwb
        4936             :
        4937           0 :     if( D*dpen .lt. 1.e-8_r8 ) then
        4938           0 :         if( s00 .ge. 0._r8 ) then
        4939             :             x0 = dpen
        4940             :         else
        4941           0 :             x0 = max(0._r8,min(dpen,-0.5_r8*wtwb/s00))
        4942             :         endif
        4943             :     else
        4944           0 :         if( s00 .ge. 0._r8 ) then
        4945           0 :             x0 = dpen
        4946             :         else
        4947             :             x0 = 0._r8
        4948             :         endif
        4949           0 :         do iteration = 1, 5
        4950             :            f  = exp(-2._r8*D*x0)*(wtwb-(bogbot-SB/(2._r8*D))/(D*rho0j)) + &
        4951           0 :                                  (SB*x0+bogbot-SB/(2._r8*D))/(D*rho0j)
        4952             :            fs = -2._r8*D*exp(-2._r8*D*x0)*(wtwb-(bogbot-SB/(2._r8*D))/(D*rho0j)) + &
        4953           0 :                                  (SB)/(D*rho0j)
        4954           0 :            if( fs .ge. 0._r8 ) then
        4955           0 :                 fs = max(fs, 1.e-10_r8)
        4956             :            else
        4957           0 :                 fs = min(fs,-1.e-10_r8)
        4958             :            endif
        4959           0 :            x1 = x0 - f/fs
        4960           0 :            x0 = x1
        4961             :       end do
        4962             :
        4963             :     endif
        4964             :
        4965           0 :     compute_ppen = -max(0._r8,min(dpen,x0))
        4966             :
        4967           0 :   end function compute_ppen
        4968             :
        4969           0 :   subroutine fluxbelowinv(cbmf,ps0,mkx,kinv,dt,xsrc,xmean,xtopin,xbotin,xflx)
        4970             :   ! ------------------------------------------------------------------------- !
        4971             :   ! Subroutine to calculate turbulent fluxes at and below 'kinv-1' interfaces.!
        4972             :   ! Check in the main program such that input 'cbmf' should not be zero.      !
        4973             :   ! If the reconstructed inversion height does not go down below the 'kinv-1' !
        4974             :   ! interface, then turbulent flux at 'kinv-1' interface  is simply a product !
        4975             :   ! of 'cmbf' and 'qtsrc-xbot' where 'xbot' is the value at the top interface !
        4976             :   ! of 'kinv-1' layer. This flux is linearly interpolated down to the surface !
        4977             :   ! assuming turbulent fluxes at surface are zero. If reconstructed inversion !
        4978             :   ! height goes down below the 'kinv-1' interface, subsidence warming &drying !
        4979             :   ! measured by 'xtop-xbot', where  'xtop' is the value at the base interface !
        4980             :   ! of 'kinv+1' layer, is added ONLY to the 'kinv-1' layer, using appropriate !
        4981             :   ! mass weighting ( rpinv and rcbmf, or rr = rpinv / rcbmf ) between current !
        4982             :   ! and next provisional time step. Also impose a limiter to enforce outliers !
        4983             :   ! of thermodynamic variables in 'kinv' layer  to come back to normal values !
        4984             :   ! at the next step.                                                         !
        4985             :   ! ------------------------------------------------------------------------- !
        4986             :     integer,  intent(in)                     :: mkx, kinv
        4987             :     real(r8), intent(in)                     :: cbmf, dt, xsrc, xmean, xtopin, xbotin
        4988             :     real(r8), intent(in),  dimension(0:mkx)  :: ps0
        4989             :     real(r8), intent(out), dimension(0:mkx)  :: xflx
        4990             :     integer k
        4991             :     real(r8) rcbmf, rpeff, dp, rr, pinv_eff, xtop, xbot, pinv, xtop_ori, xbot_ori
        4992             :
        4993           0 :     xflx(0:mkx) = 0._r8
        4994           0 :     dp = ps0(kinv-1) - ps0(kinv)
        4995           0 :     xbot = xbotin
        4996           0 :     xtop = xtopin
        4997             :
        4998             :     ! -------------------------------------- !
        4999             :     ! Compute reconstructed inversion height !
        5000             :     ! -------------------------------------- !
        5001           0 :     xtop_ori = xtop
        5002           0 :     xbot_ori = xbot
        5003           0 :     rcbmf = ( cbmf * g * dt ) / dp                  ! Can be larger than 1 : 'OK'
        5004             :
        5005           0 :     if( xbot .ge. xtop ) then
        5006           0 :         rpeff = ( xmean - xtop ) / max(  1.e-20_r8, xbot - xtop )
        5007             :     else
        5008           0 :         rpeff = ( xmean - xtop ) / min( -1.e-20_r8, xbot - xtop )
        5009             :     endif
        5010             :
        5011           0 :     rpeff = min( max(0._r8,rpeff), 1._r8 )          ! As of this, 0<= rpeff <= 1
        5012           0 :     if( rpeff .eq. 0._r8 .or. rpeff .eq. 1._r8 ) then
        5013           0 :         xbot = xmean
        5014           0 :         xtop = xmean
        5015             :     endif
        5016             :     ! Below two commented-out lines are the old code replacing the above 'if' block.
        5017             :     ! if(rpeff.eq.1) xbot = xmean
        5018             :     ! if(rpeff.eq.0) xtop = xmean
        5019           0 :     rr       = rpeff / rcbmf
        5020           0 :     pinv     = ps0(kinv-1) - rpeff * dp             ! "pinv" before detraining mass
        5021           0 :     pinv_eff = ps0(kinv-1) + ( rcbmf - rpeff ) * dp ! Effective "pinv" after detraining mass
        5022             :     ! ----------------------------------------------------------------------- !
        5023             :     ! Compute turbulent fluxes.                                               !
        5024             :     ! Below two cases exactly converges at 'kinv-1' interface when rr = 1._r8 !
        5025             :     ! ----------------------------------------------------------------------- !
        5026           0 :     do k = 0, kinv - 1
        5027           0 :        xflx(k) = cbmf * ( xsrc - xbot ) * ( ps0(0) - ps0(k) ) / ( ps0(0) - pinv )
        5028             :     end do
        5029           0 :     if( rr .le. 1._r8 ) then
        5030           0 :         xflx(kinv-1) =  xflx(kinv-1) - ( 1._r8 - rr ) * cbmf * ( xtop_ori - xbot_ori )
        5031             :     endif
        5032             :
        5033           0 :     return
        5034             :   end subroutine fluxbelowinv
        5035             :
        5036           0 :   subroutine positive_moisture_single( xlv, xls, mkx, dt, qvmin, qlmin, qimin, dp, qv, ql, qi, s, qvten, qlten, qiten, sten )
        5037             :   ! ------------------------------------------------------------------------------- !
        5038             :   ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer,         !
        5039             :   ! force them to be larger than minimum value by (1) condensating water vapor      !
        5040             :   ! into liquid or ice, and (2) by transporting water vapor from the very lower     !
        5041             :   ! layer. '2._r8' is multiplied to the minimum values for safety.                  !
        5042             :   ! Update final state variables and tendencies associated with this correction.    !
        5043             :   ! If any condensation happens, update (s,t) too.                                  !
        5044             :   ! Note that (qv,ql,qi,s) are final state variables after applying corresponding   !
        5045             :   ! input tendencies and corrective tendencies                                      !
        5046             :   ! ------------------------------------------------------------------------------- !
        5047             :     implicit none
        5048             :     integer,  intent(in)     :: mkx
        5049             :     real(r8), intent(in)     :: xlv, xls
        5050             :     real(r8), intent(in)     :: dt, qvmin, qlmin, qimin
        5051             :     real(r8), intent(in)     :: dp(mkx)
        5052             :     real(r8), intent(inout)  :: qv(mkx), ql(mkx), qi(mkx), s(mkx)
        5053             :     real(r8), intent(inout)  :: qvten(mkx), qlten(mkx), qiten(mkx), sten(mkx)
        5054             :     integer   k
        5055             :     real(r8)  dql, dqi, dqv, sum, aa, dum
        5056             :
        5057           0 :     do k = mkx, 1, -1        ! From the top to the 1st (lowest) layer from the surface
        5058           0 :        dql = max(0._r8,1._r8*qlmin-ql(k))
        5059           0 :        dqi = max(0._r8,1._r8*qimin-qi(k))
        5060           0 :        qlten(k) = qlten(k) +  dql/dt
        5061           0 :        qiten(k) = qiten(k) +  dqi/dt
        5062           0 :        qvten(k) = qvten(k) - (dql+dqi)/dt
        5063           0 :        sten(k)  = sten(k)  + xlv * (dql/dt) + xls * (dqi/dt)
        5064           0 :        ql(k)    = ql(k) +  dql
        5065           0 :        qi(k)    = qi(k) +  dqi
        5066           0 :        qv(k)    = qv(k) -  dql - dqi
        5067           0 :        s(k)     = s(k)  +  xlv * dql + xls * dqi
        5068           0 :        dqv      = max(0._r8,1._r8*qvmin-qv(k))
        5069           0 :        qvten(k) = qvten(k) + dqv/dt
        5070           0 :        qv(k)    = qv(k)   + dqv
        5071           0 :        if( k .ne. 1 ) then
        5072           0 :            qv(k-1)    = qv(k-1)    - dqv*dp(k)/dp(k-1)
        5073           0 :            qvten(k-1) = qvten(k-1) - dqv*dp(k)/dp(k-1)/dt
        5074             :        endif
        5075           0 :        qv(k) = max(qv(k),qvmin)
        5076           0 :        ql(k) = max(ql(k),qlmin)
        5077           0 :        qi(k) = max(qi(k),qimin)
        5078             :     end do
        5079             :     ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally
        5080             :     ! extracted from all the layers that has 'qv > 2*qvmin'. This fully
        5081             :     ! preserves column moisture.
        5082           0 :     if( dqv .gt. 1.e-20_r8 ) then
        5083             :         sum = 0._r8
        5084           0 :         do k = 1, mkx
        5085           0 :            if( qv(k) .gt. 2._r8*qvmin ) sum = sum + qv(k)*dp(k)
        5086             :         enddo
        5087           0 :         aa = dqv*dp(1)/max(1.e-20_r8,sum)
        5088           0 :         if( aa .lt. 0.5_r8 ) then
        5089           0 :             do k = 1, mkx
        5090           0 :                if( qv(k) .gt. 2._r8*qvmin ) then
        5091           0 :                    dum      = aa*qv(k)
        5092           0 :                    qv(k)    = qv(k) - dum
        5093           0 :                    qvten(k) = qvten(k) - dum/dt
        5094             :                endif
        5095             :             enddo
        5096             :         else
        5097           0 :             write(iulog,*) 'Full positive_moisture is impossible in uwshcu'
        5098             :         endif
        5099             :     endif
        5100             :
        5101           0 :     return
        5102             :   end subroutine positive_moisture_single
        5103             :
        5104             :   ! ------------------------ !
        5105             :   !                          !
        5106             :   ! End of subroutine blocks !
        5107             :   !                          !
        5108             :   ! ------------------------ !
        5109             :
        5110             :   end module uwshcu
        5111             :

Generated by: LCOV version 1.14