LCOV - code coverage report
Current view: | top level - physics/cam - macrop_driver.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 15 | 431 | 3.5 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 1 | 5 | 20.0 %

              Line data    Source code
           1             :   module macrop_driver
           2             :
           3             :   !-------------------------------------------------------------------------------------------------------
           4             :   ! Purpose:
           5             :   !
           6             :   ! Provides the CAM interface to the prognostic cloud macrophysics
           7             :   !
           8             :   ! Author: Andrew Gettelman, Cheryl Craig October 2010
           9             :   ! Origin: modified from stratiform.F90 elements
          10             :   !    (Boville 2002, Coleman 2004, Park 2009, Kay 2010)
          11             :   !-------------------------------------------------------------------------------------------------------
          12             :
          13             :   use shr_kind_mod,  only: r8=>shr_kind_r8
          14             :   use spmd_utils,    only: masterproc
          15             :   use ppgrid,        only: pcols, pver, pverp
          16             :   use physconst,     only: latice, latvap
          17             :   use phys_control,  only: phys_getopts
          18             :   use constituents,  only: cnst_get_ind, pcnst
          19             :   use physics_buffer,    only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx
          20             :   use time_manager,      only: is_first_step
          21             :   use cldwat2m_macro,    only: ini_macro
          22             :   use perf_mod,          only: t_startf, t_stopf
          23             :   use cam_logfile,       only: iulog
          24             :   use cam_abortutils,    only: endrun
          25             :
          26             :   implicit none
          27             :   private
          28             :   save
          29             :
          30             :   public :: macrop_driver_readnl
          31             :   public :: macrop_driver_register
          32             :   public :: macrop_driver_init
          33             :   public :: macrop_driver_tend
          34             :   public :: liquid_macro_tend
          35             :
          36             :   logical, public :: do_cldice             ! .true., park macrophysics is prognosing cldice
          37             :   logical, public :: do_cldliq             ! .true., park macrophysics is prognosing cldliq
          38             :   logical, public :: do_detrain            ! .true., park macrophysics is detraining ice into stratiform
          39             :
          40             :   ! ------------------------- !
          41             :   ! Private Module Parameters !
          42             :   ! ------------------------- !
          43             :
          44             :   ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus
          45             :   !               (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus,
          46             :   !               evaporate cumulus liquid condensate. This option only influences the treatment of cumulus
          47             :   !               liquid condensate, not cumulus ice condensate.
          48             :
          49             :   logical, parameter :: cu_det_st  = .false.
          50             :
          51             :   ! Parameters used for selecting generalized critical RH for liquid and ice stratus
          52             :   integer :: rhminl_opt = 0
          53             :   integer :: rhmini_opt = 0
          54             :
          55             :
          56             :   character(len=16) :: shallow_scheme
          57             :   logical           :: use_shfrc                       ! Local copy of flag from convect_shallow_use_shfrc
          58             :
          59             :   integer :: &
          60             :     ixcldliq,     &! cloud liquid amount index
          61             :     ixcldice,     &! cloud ice amount index
          62             :     ixnumliq,     &! cloud liquid number index
          63             :     ixnumice,     &! cloud ice water index
          64             :     qcwat_idx,    &! qcwat index in physics buffer
          65             :     lcwat_idx,    &! lcwat index in physics buffer
          66             :     iccwat_idx,   &! iccwat index in physics buffer
          67             :     nlwat_idx,    &! nlwat index in physics buffer
          68             :     niwat_idx,    &! niwat index in physics buffer
          69             :     tcwat_idx,    &! tcwat index in physics buffer
          70             :     CC_T_idx,     &!
          71             :     CC_qv_idx,    &!
          72             :     CC_ql_idx,    &!
          73             :     CC_qi_idx,    &!
          74             :     CC_nl_idx,    &!
          75             :     CC_ni_idx,    &!
          76             :     CC_qlst_idx,  &!
          77             :     cld_idx,      &! cld index in physics buffer
          78             :     ast_idx,      &! stratiform cloud fraction index in physics buffer
          79             :     aist_idx,     &! ice stratiform cloud fraction index in physics buffer
          80             :     alst_idx,     &! liquid stratiform cloud fraction index in physics buffer
          81             :     qist_idx,     &! ice stratiform in-cloud IWC
          82             :     qlst_idx,     &! liquid stratiform in-cloud LWC
          83             :     concld_idx,   &! concld index in physics buffer
          84             :     fice_idx,     &
          85             :     cmeliq_idx,   &
          86             :     shfrc_idx
          87             :
          88             :   integer :: &
          89             :     dlfzm_idx  = -1,    & ! ZM detrained convective cloud water mixing ratio.
          90             :     difzm_idx  = -1,    & ! ZM detrained convective cloud ice mixing ratio.
          91             :     dnlfzm_idx = -1,    & ! ZM detrained convective cloud water num concen.
          92             :     dnifzm_idx = -1       ! ZM detrained convective cloud ice num concen.
          93             :
          94             :
          95             :   integer :: &
          96             :     tke_idx = -1,       &! tke defined at the model interfaces
          97             :     qtl_flx_idx = -1,   &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme
          98             :     qti_flx_idx = -1,   &! overbar(w'qti' where qti = qv + qi) from the PBL scheme
          99             :     cmfr_det_idx = -1,  &! detrained convective mass flux from UNICON
         100             :     qlr_det_idx = -1,   &! detrained convective ql from UNICON
         101             :     qir_det_idx = -1,   &! detrained convective qi from UNICON
         102             :     cmfmc_sh_idx = -1
         103             :
         104             :   contains
         105             :
         106             :   ! ===============================================================================
         107        1536 :   subroutine macrop_driver_readnl(nlfile)
         108             :
         109             :     use namelist_utils,  only: find_group_name
         110             :     use units,           only: getunit, freeunit
         111             :     use mpishorthand
         112             :
         113             :     character(len=*), intent(in) :: nlfile  ! filepath for file containing namelist input
         114             :
         115             :    ! Namelist variables
         116             :    logical  :: macro_park_do_cldice  = .true.   ! do_cldice = .true., park macrophysics is prognosing cldice
         117             :    logical  :: macro_park_do_cldliq  = .true.   ! do_cldliq = .true., park macrophysics is prognosing cldliq
         118             :    logical  :: macro_park_do_detrain = .true.   ! do_detrain = .true., park macrophysics is detraining ice into stratiform
         119             :
         120             :    ! Local variables
         121             :    integer :: unitn, ierr
         122             :    character(len=*), parameter :: subname = 'macrop_driver_readnl'
         123             :
         124             :    namelist /macro_park_nl/ macro_park_do_cldice, macro_park_do_cldliq, macro_park_do_detrain
         125             :    !-----------------------------------------------------------------------------
         126             :
         127        1536 :    if (masterproc) then
         128           2 :       unitn = getunit()
         129           2 :       open( unitn, file=trim(nlfile), status='old' )
         130           2 :       call find_group_name(unitn, 'macro_park_nl', status=ierr)
         131           2 :       if (ierr == 0) then
         132           0 :          read(unitn, macro_park_nl, iostat=ierr)
         133           0 :          if (ierr /= 0) then
         134           0 :             call endrun(subname // ':: ERROR reading namelist')
         135             :          end if
         136             :       end if
         137           2 :       close(unitn)
         138           2 :       call freeunit(unitn)
         139             :
         140             :       ! set local variables
         141             :
         142           2 :       do_cldice  = macro_park_do_cldice
         143           2 :       do_cldliq  = macro_park_do_cldliq
         144           2 :       do_detrain = macro_park_do_detrain
         145             :
         146             :    end if
         147             :
         148             : #ifdef SPMD
         149             :    ! Broadcast namelist variables
         150        1536 :    call mpibcast(do_cldice,             1, mpilog, 0, mpicom)
         151        1536 :    call mpibcast(do_cldliq,             1, mpilog, 0, mpicom)
         152        1536 :    call mpibcast(do_detrain,            1, mpilog, 0, mpicom)
         153             : #endif
         154             :
         155        1536 : end subroutine macrop_driver_readnl
         156             :
         157             :   !================================================================================================
         158             :
         159           0 :   subroutine macrop_driver_register
         160             :
         161             :   !---------------------------------------------------------------------- !
         162             :   !                                                                       !
         163             :   ! Register the constituents (cloud liquid and cloud ice) and the fields !
         164             :   ! in the physics buffer.                                                !
         165             :   !                                                                       !
         166             :   !---------------------------------------------------------------------- !
         167             :
         168             :
         169             :    use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls
         170             :
         171             :   !-----------------------------------------------------------------------
         172             :
         173           0 :     call phys_getopts(shallow_scheme_out=shallow_scheme)
         174             :
         175           0 :     call pbuf_add_field('AST',      'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx)
         176           0 :     call pbuf_add_field('AIST',     'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx)
         177           0 :     call pbuf_add_field('ALST',     'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx)
         178           0 :     call pbuf_add_field('QIST',     'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx)
         179           0 :     call pbuf_add_field('QLST',     'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx)
         180           0 :     call pbuf_add_field('CLD',      'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx)
         181           0 :     call pbuf_add_field('CONCLD',   'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx)
         182             :
         183           0 :     call pbuf_add_field('QCWAT',    'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), qcwat_idx)
         184           0 :     call pbuf_add_field('LCWAT',    'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), lcwat_idx)
         185           0 :     call pbuf_add_field('ICCWAT',   'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), iccwat_idx)
         186           0 :     call pbuf_add_field('NLWAT',    'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), nlwat_idx)
         187           0 :     call pbuf_add_field('NIWAT',    'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), niwat_idx)
         188           0 :     call pbuf_add_field('TCWAT',    'global',  dtype_r8, (/pcols,pver,dyn_time_lvls/), tcwat_idx)
         189             :
         190           0 :     call pbuf_add_field('FICE',     'physpkg', dtype_r8, (/pcols,pver/), fice_idx)
         191             :
         192           0 :     call pbuf_add_field('CMELIQ',   'physpkg', dtype_r8, (/pcols,pver/), cmeliq_idx)
         193             :
         194           0 :   end subroutine macrop_driver_register
         195             :
         196             :   !============================================================================ !
         197             :   !                                                                             !
         198             :   !============================================================================ !
         199             :
         200           0 :   subroutine macrop_driver_init(pbuf2d)
         201             :
         202             :   !-------------------------------------------- !
         203             :   !                                             !
         204             :   ! Initialize the cloud water parameterization !
         205             :   !                                             !
         206             :   !-------------------------------------------- !
         207           0 :     use physics_buffer, only : pbuf_get_index
         208             :     use cam_history,     only: addfld, add_default
         209             :     use convect_shallow, only: convect_shallow_use_shfrc
         210             :
         211             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
         212             :
         213             :     logical              :: history_aerosol      ! Output the MAM aerosol tendencies
         214             :     logical              :: history_budget       ! Output tendencies and state variables for CAM4
         215             :                                                  ! temperature, water vapor, cloud ice and cloud
         216             :                                                  ! liquid budgets.
         217             :     integer              :: history_budget_histfile_num ! output history file number for budget fields
         218             :     integer :: istat
         219             :
         220             :     character(len=*), parameter :: subname = 'macrop_driver_init'
         221             :     !-----------------------------------------------------------------------
         222             :
         223             :     ! Initialization routine for cloud macrophysics
         224           0 :     if (shallow_scheme .eq. 'UNICON') rhminl_opt = 1
         225           0 :     call ini_macro(rhminl_opt, rhmini_opt)
         226             :
         227             :     call phys_getopts(history_aerosol_out              = history_aerosol      , &
         228             :                       history_budget_out               = history_budget       , &
         229           0 :                       history_budget_histfile_num_out  = history_budget_histfile_num )
         230             :
         231             :   ! Find out whether shfrc from convect_shallow will be used in cldfrc
         232             :
         233           0 :     if( convect_shallow_use_shfrc() ) then
         234           0 :         use_shfrc = .true.
         235           0 :         shfrc_idx = pbuf_get_index('shfrc')
         236             :     else
         237           0 :         use_shfrc = .false.
         238             :     endif
         239             :
         240           0 :     call addfld ('DPDLFLIQ',  (/ 'lev' /), 'A', 'kg/kg/s',  'Detrained liquid water from deep convection'       )
         241           0 :     call addfld ('DPDLFICE',  (/ 'lev' /), 'A', 'kg/kg/s',  'Detrained ice from deep convection'                )
         242           0 :     call addfld ('SHDLFLIQ',  (/ 'lev' /), 'A', 'kg/kg/s',  'Detrained liquid water from shallow convection'    )
         243           0 :     call addfld ('SHDLFICE',  (/ 'lev' /), 'A', 'kg/kg/s',  'Detrained ice from shallow convection'             )
         244           0 :     call addfld ('DPDLFT',    (/ 'lev' /), 'A', 'K/s',      'T-tendency due to deep convective detrainment'     )
         245           0 :     call addfld ('SHDLFT',    (/ 'lev' /), 'A', 'K/s',      'T-tendency due to shallow convective detrainment'  )
         246             :
         247           0 :     call addfld ('ZMDLF',     (/ 'lev' /), 'A', 'kg/kg/s',  'Detrained liquid water from ZM convection'         )
         248             :
         249           0 :     call addfld ('MACPDT',    (/ 'lev' /), 'A', 'W/kg',     'Heating tendency - Revised  macrophysics'          )
         250           0 :     call addfld ('MACPDQ',    (/ 'lev' /), 'A', 'kg/kg/s',  'Q tendency - Revised macrophysics'                 )
         251           0 :     call addfld ('MACPDLIQ',  (/ 'lev' /), 'A', 'kg/kg/s',  'CLDLIQ tendency - Revised macrophysics'            )
         252           0 :     call addfld ('MACPDICE',  (/ 'lev' /), 'A', 'kg/kg/s',  'CLDICE tendency - Revised macrophysics'            )
         253             :
         254             :     call addfld ('CLDVAPADJ', (/ 'lev' /), 'A', 'kg/kg/s',  &
         255           0 :          'Q tendency associated with liq/ice adjustment - Revised macrophysics'                                 )
         256           0 :     call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s',  'CLDLIQ adjustment tendency - Revised macrophysics' )
         257           0 :     call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s',  'CLDICE adjustment tendency - Revised macrophysics' )
         258             :     call addfld ('CLDLIQDET', (/ 'lev' /), 'A', 'kg/kg/s',  &
         259           0 :          'Detrainment of conv cld liq into envrionment  - Revised macrophysics'                                 )
         260             :     call addfld ('CLDICEDET', (/ 'lev' /), 'A', 'kg/kg/s',  &
         261           0 :          'Detrainment of conv cld ice into envrionment  - Revised macrophysics'                                 )
         262           0 :     call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s',  'CLDLIQ limiting tendency - Revised macrophysics'   )
         263           0 :     call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s',  'CLDICE limiting tendency - Revised macrophysics'   )
         264             :
         265           0 :     call addfld ('AST',       (/ 'lev' /), 'A', '1',        'Stratus cloud fraction'                            )
         266           0 :     call addfld ('LIQCLDF',   (/ 'lev' /), 'A', '1',        'Stratus Liquid cloud fraction'                     )
         267           0 :     call addfld ('ICECLDF',   (/ 'lev' /), 'A', '1',        'Stratus ICE cloud fraction'                        )
         268             :
         269           0 :     call addfld ('CLDST',     (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction'                            )
         270           0 :     call addfld ('CONCLD',    (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover'                            )
         271             :
         272           0 :     call addfld ('CLR_LIQ',   (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus'             )
         273           0 :     call addfld ('CLR_ICE',   (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus'                )
         274             :
         275           0 :     call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg',    'Stratiform CLDLIQ'                                 )
         276           0 :     call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg',    'Stratiform CLDICE'                                 )
         277           0 :     call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg',    'Convective CLDLIQ'                                 )
         278           0 :     call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg',    'Convective CLDICE'                                 )
         279             :
         280           0 :     call addfld ('CLDSICE',   (/ 'lev' /), 'A', 'kg/kg',    'CloudSat equivalent ice mass mixing ratio'         )
         281           0 :     call addfld ('CMELIQ',    (/ 'lev' /), 'A', 'kg/kg/s',  'Rate of cond-evap of liq within the cloud'         )
         282             :
         283           0 :     call addfld ('TTENDICE',  (/ 'lev' /), 'A', 'K/s',      'T tendency from Ice Saturation Adjustment'         )
         284           0 :     call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s',  'Q tendency from Ice Saturation Adjustment'         )
         285           0 :     call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s',  'CLDICE tendency from Ice Saturation Adjustment'    )
         286           0 :     call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s',  'NUMICE tendency from Ice Saturation Adjustment'    )
         287           0 :     if ( history_budget ) then
         288             :
         289           0 :           call add_default ('DPDLFLIQ ', history_budget_histfile_num, ' ')
         290           0 :           call add_default ('DPDLFICE ', history_budget_histfile_num, ' ')
         291           0 :           call add_default ('SHDLFLIQ ', history_budget_histfile_num, ' ')
         292           0 :           call add_default ('SHDLFICE ', history_budget_histfile_num, ' ')
         293           0 :           call add_default ('DPDLFT   ', history_budget_histfile_num, ' ')
         294           0 :           call add_default ('SHDLFT   ', history_budget_histfile_num, ' ')
         295           0 :           call add_default ('ZMDLF    ', history_budget_histfile_num, ' ')
         296             :
         297           0 :           call add_default ('MACPDT   ', history_budget_histfile_num, ' ')
         298           0 :           call add_default ('MACPDQ   ', history_budget_histfile_num, ' ')
         299           0 :           call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ')
         300           0 :           call add_default ('MACPDICE ', history_budget_histfile_num, ' ')
         301             :
         302           0 :           call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ')
         303           0 :           call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ')
         304           0 :           call add_default ('CLDLIQDET', history_budget_histfile_num, ' ')
         305           0 :           call add_default ('CLDLIQADJ', history_budget_histfile_num, ' ')
         306           0 :           call add_default ('CLDICELIM', history_budget_histfile_num, ' ')
         307           0 :           call add_default ('CLDICEDET', history_budget_histfile_num, ' ')
         308           0 :           call add_default ('CLDICEADJ', history_budget_histfile_num, ' ')
         309             :
         310           0 :           call add_default ('CMELIQ   ', history_budget_histfile_num, ' ')
         311             :
         312             :     end if
         313             :
         314             :     ! Get constituent indices
         315           0 :     call cnst_get_ind('CLDLIQ', ixcldliq)
         316           0 :     call cnst_get_ind('CLDICE', ixcldice)
         317           0 :     call cnst_get_ind('NUMLIQ', ixnumliq)
         318           0 :     call cnst_get_ind('NUMICE', ixnumice)
         319             :
         320             :     ! Get physics buffer indices
         321           0 :     CC_T_idx    = pbuf_get_index('CC_T')
         322           0 :     CC_qv_idx   = pbuf_get_index('CC_qv')
         323           0 :     CC_ql_idx   = pbuf_get_index('CC_ql')
         324           0 :     CC_qi_idx   = pbuf_get_index('CC_qi')
         325           0 :     CC_nl_idx   = pbuf_get_index('CC_nl')
         326           0 :     CC_ni_idx   = pbuf_get_index('CC_ni')
         327           0 :     CC_qlst_idx = pbuf_get_index('CC_qlst')
         328           0 :     cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
         329             :
         330           0 :     if (rhminl_opt > 0 .or. rhmini_opt > 0) then
         331           0 :        cmfr_det_idx = pbuf_get_index('cmfr_det', istat)
         332           0 :        if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf')
         333           0 :        if (rhminl_opt > 0) then
         334           0 :           qlr_det_idx  = pbuf_get_index('qlr_det', istat)
         335           0 :           if (istat < 0) call endrun(subname//': macrop option requires qlr_det in pbuf')
         336             :        end if
         337           0 :        if (rhmini_opt > 0) then
         338           0 :           qir_det_idx  = pbuf_get_index('qir_det', istat)
         339           0 :           if (istat < 0) call endrun(subname//': macrop option requires qir_det in pbuf')
         340             :        end if
         341             :     end if
         342             :
         343           0 :     if (rhminl_opt == 2 .or. rhmini_opt == 2) then
         344           0 :        tke_idx = pbuf_get_index('tke')
         345           0 :        if (rhminl_opt == 2) then
         346           0 :           qtl_flx_idx = pbuf_get_index('qtl_flx', istat)
         347           0 :           if (istat < 0) call endrun(subname//': macrop option requires qtl_flx in pbuf')
         348             :        end if
         349           0 :        if (rhmini_opt == 2) then
         350           0 :           qti_flx_idx = pbuf_get_index('qti_flx', istat)
         351           0 :           if (istat < 0) call endrun(subname//': macrop option requires qti_flx in pbuf')
         352             :        end if
         353             :     end if
         354             :
         355             :     ! Init pbuf fields.  Note that the fields CLD, CONCLD, QCWAT, LCWAT,
         356             :     ! ICCWAT, and TCWAT are initialized in phys_inidat.
         357           0 :     if (is_first_step()) then
         358           0 :        call pbuf_set_field(pbuf2d, ast_idx,    0._r8)
         359           0 :        call pbuf_set_field(pbuf2d, aist_idx,   0._r8)
         360           0 :        call pbuf_set_field(pbuf2d, alst_idx,   0._r8)
         361           0 :        call pbuf_set_field(pbuf2d, qist_idx,   0._r8)
         362           0 :        call pbuf_set_field(pbuf2d, qlst_idx,   0._r8)
         363           0 :        call pbuf_set_field(pbuf2d, nlwat_idx,  0._r8)
         364           0 :        call pbuf_set_field(pbuf2d, niwat_idx,  0._r8)
         365             :     end if
         366             :
         367             :     ! the following are physpkg, so they need to be init every time
         368           0 :     call pbuf_set_field(pbuf2d, fice_idx,   0._r8)
         369           0 :     call pbuf_set_field(pbuf2d, cmeliq_idx, 0._r8)
         370             :
         371           0 :   end subroutine macrop_driver_init
         372             :
         373             :   !============================================================================ !
         374             :   !                                                                             !
         375             :   !============================================================================ !
         376             :
         377             :
         378           0 :   subroutine macrop_driver_tend(                             &
         379             :              state, ptend, dtime, landfrac,  &
         380             :              ocnfrac,  snowh,                       &
         381             :              dlf, dlf2, cmfmc, ts,          &
         382             :              sst, zdu,       &
         383             :              pbuf, &
         384             :              det_s, det_ice)
         385             :
         386             :   !-------------------------------------------------------- !
         387             :   !                                                         !
         388             :   ! Purpose:                                                !
         389             :   !                                                         !
         390             :   ! Interface to detrain, cloud fraction and                !
         391             :   !     cloud macrophysics subroutines                      !
         392             :   !                                                         !
         393             :   ! Author: A. Gettelman, C. Craig, Oct 2010                !
         394             :   ! based on stratiform_tend by D.B. Coleman 4/2010         !
         395             :   !                                                         !
         396             :   !-------------------------------------------------------- !
         397             :
         398           0 :   use cloud_fraction,   only: cldfrc, cldfrc_fice
         399             :   use physics_types,    only: physics_state, physics_ptend
         400             :   use physics_types,    only: physics_ptend_init, physics_update
         401             :   use physics_types,    only: physics_ptend_sum,  physics_state_copy
         402             :   use physics_types,    only: physics_state_dealloc
         403             :   use cam_history,      only: outfld
         404             :   use constituents,     only: cnst_get_ind, pcnst
         405             :   use cldwat2m_macro,   only: mmacro_pcond
         406             :   use physconst,        only: cpair, tmelt, gravit
         407             :   use time_manager,     only: get_nstep
         408             :
         409             :   use ref_pres,         only: top_lev => trop_cloud_top_lev
         410             :
         411             :   !
         412             :   ! Input arguments
         413             :   !
         414             :
         415             :   type(physics_state), intent(in)    :: state       ! State variables
         416             :   type(physics_ptend), intent(out)   :: ptend       ! macrophysics parameterization tendencies
         417             :   type(physics_buffer_desc), pointer :: pbuf(:)     ! Physics buffer
         418             :
         419             :   real(r8), intent(in)  :: dtime                    ! Timestep
         420             :   real(r8), intent(in)  :: landfrac(pcols)          ! Land fraction (fraction)
         421             :   real(r8), intent(in)  :: ocnfrac (pcols)          ! Ocean fraction (fraction)
         422             :   real(r8), intent(in)  :: snowh(pcols)             ! Snow depth over land, water equivalent (m)
         423             :   real(r8), intent(in)  :: dlf(pcols,pver)          ! Detrained water from convection schemes
         424             :   real(r8), intent(in)  :: dlf2(pcols,pver)         ! Detrained water from shallow convection scheme
         425             :   real(r8), intent(in)  :: cmfmc(pcols,pverp)       ! Deep + Shallow Convective mass flux [ kg /s/m^2 ]
         426             :
         427             :   real(r8), intent(in)  :: ts(pcols)                ! Surface temperature
         428             :   real(r8), intent(in)  :: sst(pcols)               ! Sea surface temperature
         429             :   real(r8), intent(in)  :: zdu(pcols,pver)          ! Detrainment rate from deep convection
         430             :
         431             :
         432             :   ! These two variables are needed for energy check
         433             :   real(r8), intent(out) :: det_s(pcols)             ! Integral of detrained static energy from ice
         434             :   real(r8), intent(out) :: det_ice(pcols)           ! Integral of detrained ice for energy check
         435             :
         436             :   !
         437             :   ! Local variables
         438             :   !
         439             :
         440           0 :   type(physics_state) :: state_loc                  ! Local copy of the state variable
         441           0 :   type(physics_ptend) :: ptend_loc                  ! Local parameterization tendencies
         442             :
         443             :   integer i,k
         444             :   integer :: lchnk                                  ! Chunk identifier
         445             :   integer :: ncol                                   ! Number of atmospheric columns
         446             :
         447             :   ! Physics buffer fields
         448             :
         449             :   integer itim_old
         450           0 :   real(r8), pointer, dimension(:,:) :: qcwat        ! Cloud water old q
         451           0 :   real(r8), pointer, dimension(:,:) :: tcwat        ! Cloud water old temperature
         452           0 :   real(r8), pointer, dimension(:,:) :: lcwat        ! Cloud liquid water old q
         453           0 :   real(r8), pointer, dimension(:,:) :: iccwat       ! Cloud ice water old q
         454           0 :   real(r8), pointer, dimension(:,:) :: nlwat        ! Cloud liquid droplet number condentration. old.
         455           0 :   real(r8), pointer, dimension(:,:) :: niwat        ! Cloud ice    droplet number condentration. old.
         456           0 :   real(r8), pointer, dimension(:,:) :: CC_T         ! Grid-mean microphysical tendency
         457           0 :   real(r8), pointer, dimension(:,:) :: CC_qv        ! Grid-mean microphysical tendency
         458           0 :   real(r8), pointer, dimension(:,:) :: CC_ql        ! Grid-mean microphysical tendency
         459           0 :   real(r8), pointer, dimension(:,:) :: CC_qi        ! Grid-mean microphysical tendency
         460           0 :   real(r8), pointer, dimension(:,:) :: CC_nl        ! Grid-mean microphysical tendency
         461           0 :   real(r8), pointer, dimension(:,:) :: CC_ni        ! Grid-mean microphysical tendency
         462           0 :   real(r8), pointer, dimension(:,:) :: CC_qlst      ! In-liquid stratus microphysical tendency
         463           0 :   real(r8), pointer, dimension(:,:) :: cld          ! Total cloud fraction
         464           0 :   real(r8), pointer, dimension(:,:) :: ast          ! Relative humidity cloud fraction
         465           0 :   real(r8), pointer, dimension(:,:) :: aist         ! Physical ice stratus fraction
         466           0 :   real(r8), pointer, dimension(:,:) :: alst         ! Physical liquid stratus fraction
         467           0 :   real(r8), pointer, dimension(:,:) :: qist         ! Physical in-cloud IWC
         468           0 :   real(r8), pointer, dimension(:,:) :: qlst         ! Physical in-cloud LWC
         469           0 :   real(r8), pointer, dimension(:,:) :: concld       ! Convective cloud fraction
         470             :
         471           0 :   real(r8), pointer, dimension(:,:) :: shfrc        ! Cloud fraction from shallow convection scheme
         472           0 :   real(r8), pointer, dimension(:,:) :: cmfmc_sh     ! Shallow convective mass flux (pcols,pverp) [ kg/s/m^2 ]
         473             :
         474           0 :   real(r8), pointer, dimension(:,:) :: cmeliq
         475             :
         476           0 :   real(r8), pointer, dimension(:,:) :: tke
         477           0 :   real(r8), pointer, dimension(:,:) :: qtl_flx
         478           0 :   real(r8), pointer, dimension(:,:) :: qti_flx
         479           0 :   real(r8), pointer, dimension(:,:) :: cmfr_det
         480           0 :   real(r8), pointer, dimension(:,:) :: qlr_det
         481           0 :   real(r8), pointer, dimension(:,:) :: qir_det
         482             :
         483             :   ! Convective cloud to the physics buffer for purposes of ql contrib. to radn.
         484             :
         485           0 :   real(r8), pointer, dimension(:,:) :: fice_ql      ! Cloud ice/water partitioning ratio.
         486             :
         487             :   ! ZM microphysics
         488             :   real(r8), pointer :: dlfzm(:,:)  ! ZM detrained convective cloud water mixing ratio.
         489             :   real(r8), pointer :: difzm(:,:)  ! ZM detrained convective cloud ice mixing ratio.
         490             :   real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen.
         491             :   real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen.
         492             :
         493             :   real(r8) :: latsub
         494             :
         495             :   ! tendencies for ice saturation adjustment
         496             :   real(r8)  :: stend(pcols,pver)
         497             :   real(r8)  :: qvtend(pcols,pver)
         498             :   real(r8)  :: qitend(pcols,pver)
         499             :   real(r8)  :: initend(pcols,pver)
         500             :
         501             :   ! Local variables for cldfrc
         502             :
         503             :   real(r8)  cldst(pcols,pver)                       ! Stratus cloud fraction
         504             :   real(r8)  rhcloud(pcols,pver)                     ! Relative humidity cloud (last timestep)
         505             :   real(r8)  clc(pcols)                              ! Column convective cloud amount
         506             :   real(r8)  rhu00(pcols,pver)                       ! RH threshold for cloud
         507             :   real(r8)  icecldf(pcols,pver)                     ! Ice cloud fraction
         508             :   real(r8)  liqcldf(pcols,pver)                     ! Liquid cloud fraction (combined into cloud)
         509             :   real(r8)  relhum(pcols,pver)                      ! RH, output to determine drh/da
         510             :
         511             :   ! Local variables for macrophysics
         512             :
         513             :   real(r8)  rdtime                                  ! 1./dtime
         514             :   real(r8)  qtend(pcols,pver)                       ! Moisture tendencies
         515             :   real(r8)  ttend(pcols,pver)                       ! Temperature tendencies
         516             :   real(r8)  ltend(pcols,pver)                       ! Cloud liquid water tendencies
         517             :   real(r8)  fice(pcols,pver)                        ! Fractional ice content within cloud
         518             :   real(r8)  fsnow(pcols,pver)                       ! Fractional snow production
         519             :   real(r8)  homoo(pcols,pver)
         520             :   real(r8)  qcreso(pcols,pver)
         521             :   real(r8)  prcio(pcols,pver)
         522             :   real(r8)  praio(pcols,pver)
         523             :   real(r8)  qireso(pcols,pver)
         524             :   real(r8)  ftem(pcols,pver)
         525             :   real(r8)  pracso (pcols,pver)
         526             :   real(r8)  dpdlfliq(pcols,pver)
         527             :   real(r8)  dpdlfice(pcols,pver)
         528             :   real(r8)  shdlfliq(pcols,pver)
         529             :   real(r8)  shdlfice(pcols,pver)
         530             :   real(r8)  dpdlft  (pcols,pver)
         531             :   real(r8)  shdlft  (pcols,pver)
         532             :
         533             :   real(r8)  dum1
         534             :   real(r8)  qc(pcols,pver)
         535             :   real(r8)  qi(pcols,pver)
         536             :   real(r8)  nc(pcols,pver)
         537             :   real(r8)  ni(pcols,pver)
         538             :
         539             :   logical   lq(pcnst)
         540             :
         541             :   ! Output from mmacro_pcond
         542             :
         543             :   real(r8)  tlat(pcols,pver)
         544             :   real(r8)  qvlat(pcols,pver)
         545             :   real(r8)  qcten(pcols,pver)
         546             :   real(r8)  qiten(pcols,pver)
         547             :   real(r8)  ncten(pcols,pver)
         548             :   real(r8)  niten(pcols,pver)
         549             :
         550             :   ! Output from mmacro_pcond
         551             :
         552             :   real(r8)  qvadj(pcols,pver)                       ! Macro-physics adjustment tendency from "positive_moisture" call (vapor)
         553             :   real(r8)  qladj(pcols,pver)                       ! Macro-physics adjustment tendency from "positive_moisture" call (liquid)
         554             :   real(r8)  qiadj(pcols,pver)                       ! Macro-physics adjustment tendency from "positive_moisture" call (ice)
         555             :   real(r8)  qllim(pcols,pver)                       ! Macro-physics tendency from "instratus_condensate" call (liquid)
         556             :   real(r8)  qilim(pcols,pver)                       ! Macro-physics tendency from "instratus_condensate" call (ice)
         557             :
         558             :   ! For revised macophysics, mmacro_pcond
         559             :
         560             :   real(r8)  itend(pcols,pver)
         561             :   real(r8)  lmitend(pcols,pver)
         562             :   real(r8)  zeros(pcols,pver)
         563             :   real(r8)  t_inout(pcols,pver)
         564             :   real(r8)  qv_inout(pcols,pver)
         565             :   real(r8)  ql_inout(pcols,pver)
         566             :   real(r8)  qi_inout(pcols,pver)
         567             :   real(r8)  concld_old(pcols,pver)
         568             :
         569             :   ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the
         570             :   ! liquid condensation process which is using 'alst' not 'ast'.
         571             :   ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'.
         572             :   ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used.
         573             :   ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old'
         574             :   real(r8)  clrw_old(pcols,pver) ! (1 - concld_old - alst_old)
         575             :   real(r8)  clri_old(pcols,pver) ! (1 - concld_old -  ast_old)
         576             :
         577             :   real(r8)  nl_inout(pcols,pver)
         578             :   real(r8)  ni_inout(pcols,pver)
         579             :
         580             :   real(r8)  nltend(pcols,pver)
         581             :   real(r8)  nitend(pcols,pver)
         582             :
         583             :
         584             :   ! For detraining cumulus condensate into the 'stratus' without evaporation
         585             :   ! This is for use in mmacro_pcond
         586             :
         587             :   real(r8)  dlf_T(pcols,pver)
         588             :   real(r8)  dlf_qv(pcols,pver)
         589             :   real(r8)  dlf_ql(pcols,pver)
         590             :   real(r8)  dlf_qi(pcols,pver)
         591             :   real(r8)  dlf_nl(pcols,pver)
         592             :   real(r8)  dlf_ni(pcols,pver)
         593             :
         594             :   ! Local variables for CFMIP calculations
         595             :   real(r8) :: mr_lsliq(pcols,pver)  ! mixing_ratio_large_scale_cloud_liquid (kg/kg)
         596             :   real(r8) :: mr_lsice(pcols,pver)  ! mixing_ratio_large_scale_cloud_ice (kg/kg)
         597             :   real(r8) :: mr_ccliq(pcols,pver)  ! mixing_ratio_convective_cloud_liquid (kg/kg)
         598             :   real(r8) :: mr_ccice(pcols,pver)  ! mixing_ratio_convective_cloud_ice (kg/kg)
         599             :
         600             :   ! CloudSat equivalent ice mass mixing ratio (kg/kg)
         601             :   real(r8) :: cldsice(pcols,pver)
         602             :
         603             :   ! ======================================================================
         604             :
         605           0 :   lchnk = state%lchnk
         606           0 :   ncol  = state%ncol
         607             :
         608           0 :   call physics_state_copy(state, state_loc)            ! Copy state to local state_loc.
         609             :
         610             :   ! Associate pointers with physics buffer fields
         611             :
         612           0 :   itim_old = pbuf_old_tim_idx()
         613             :
         614           0 :   call pbuf_get_field(pbuf, qcwat_idx,   qcwat,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         615           0 :   call pbuf_get_field(pbuf, tcwat_idx,   tcwat,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         616           0 :   call pbuf_get_field(pbuf, lcwat_idx,   lcwat,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         617           0 :   call pbuf_get_field(pbuf, iccwat_idx,  iccwat,  start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         618           0 :   call pbuf_get_field(pbuf, nlwat_idx,   nlwat,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         619           0 :   call pbuf_get_field(pbuf, niwat_idx,   niwat,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         620             :
         621           0 :   call pbuf_get_field(pbuf, cc_t_idx,    cc_t,    start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         622           0 :   call pbuf_get_field(pbuf, cc_qv_idx,   cc_qv,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         623           0 :   call pbuf_get_field(pbuf, cc_ql_idx,   cc_ql,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         624           0 :   call pbuf_get_field(pbuf, cc_qi_idx,   cc_qi,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         625           0 :   call pbuf_get_field(pbuf, cc_nl_idx,   cc_nl,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         626           0 :   call pbuf_get_field(pbuf, cc_ni_idx,   cc_ni,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         627           0 :   call pbuf_get_field(pbuf, cc_qlst_idx, cc_qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         628             :
         629           0 :   call pbuf_get_field(pbuf, cld_idx,     cld,    start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         630           0 :   call pbuf_get_field(pbuf, concld_idx,  concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         631           0 :   call pbuf_get_field(pbuf, ast_idx,     ast,    start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         632           0 :   call pbuf_get_field(pbuf, aist_idx,    aist,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         633           0 :   call pbuf_get_field(pbuf, alst_idx,    alst,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         634           0 :   call pbuf_get_field(pbuf, qist_idx,    qist,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         635           0 :   call pbuf_get_field(pbuf, qlst_idx,    qlst,   start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
         636             :
         637           0 :   call pbuf_get_field(pbuf, cmeliq_idx,  cmeliq)
         638             :
         639             : ! For purposes of convective ql.
         640             :
         641           0 :   call pbuf_get_field(pbuf, fice_idx,     fice_ql )
         642             :
         643           0 :   call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh)
         644             :
         645             :   ! check that qcwat and tcwat were initialized; if not then do it now.
         646           0 :   if (qcwat(1,1) == huge(1._r8)) then
         647           0 :      qcwat(:ncol,:) = state%q(:ncol,:,1)
         648             :   end if
         649           0 :   if (tcwat(1,1) == huge(1._r8)) then
         650           0 :      tcwat(:ncol,:) = state%t(:ncol,:)
         651             :   end if
         652             :
         653             :   ! Initialize convective detrainment tendency
         654             :
         655           0 :   dlf_T(:,:)  = 0._r8
         656           0 :   dlf_qv(:,:) = 0._r8
         657           0 :   dlf_ql(:,:) = 0._r8
         658           0 :   dlf_qi(:,:) = 0._r8
         659           0 :   dlf_nl(:,:) = 0._r8
         660           0 :   dlf_ni(:,:) = 0._r8
         661             :
         662             :    ! ------------------------------------- !
         663             :    ! From here, process computation begins !
         664             :    ! ------------------------------------- !
         665             :
         666             :    ! ----------------------------------------------------------------------------- !
         667             :    ! Detrainment of convective condensate into the environment or stratiform cloud !
         668             :    ! ----------------------------------------------------------------------------- !
         669             :
         670           0 :    lq(:)        = .FALSE.
         671           0 :    lq(ixcldliq) = .TRUE.
         672           0 :    lq(ixcldice) = .TRUE.
         673           0 :    lq(ixnumliq) = .TRUE.
         674           0 :    lq(ixnumice) = .TRUE.
         675           0 :    call physics_ptend_init(ptend_loc, state%psetcols, 'pcwdetrain', ls=.true., lq=lq)   ! Initialize local physics_ptend object
         676             :
         677             :      ! Procedures :
         678             :      ! (1) Partition detrained convective cloud water into liquid and ice based on T.
         679             :      !     This also involves heating.
         680             :      !     If convection scheme can handle this internally, this step is not necssary.
         681             :      ! (2) Assuming a certain effective droplet radius, computes number concentration
         682             :      !     of detrained convective cloud liquid and ice.
         683             :      ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into
         684             :      !     the pre-existing 'liquid' stratus ( mean environment ).  The former does
         685             :      !     not involve any macrophysical evaporation while the latter does. This is
         686             :      !     a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded
         687             :      !     by qcst_min and qcst_max in mmacro_pcond.
         688             :      ! (4) In contrast to liquid, convective ice is detrained into the environment
         689             :      !     and involved in the sublimation. Similar bounds as liquid stratus are imposed.
         690             :      ! This is the key procesure generating upper-level cirrus clouds.
         691             :      ! The unit of dlf : [ kg/kg/s ]
         692             :
         693           0 :    det_s(:)   = 0._r8
         694           0 :    det_ice(:) = 0._r8
         695             :
         696           0 :    dpdlfliq = 0._r8
         697           0 :    dpdlfice = 0._r8
         698           0 :    shdlfliq = 0._r8
         699           0 :    shdlfice = 0._r8
         700           0 :    dpdlft   = 0._r8
         701           0 :    shdlft   = 0._r8
         702             :
         703           0 :    do k = top_lev, pver
         704           0 :    do i = 1, state_loc%ncol
         705           0 :       if( state_loc%t(i,k) > 268.15_r8 ) then
         706             :           dum1 = 0.0_r8
         707           0 :       elseif( state_loc%t(i,k) < 238.15_r8 ) then
         708             :           dum1 = 1.0_r8
         709             :       else
         710           0 :           dum1 = ( 268.15_r8 - state_loc%t(i,k) ) / 30._r8
         711             :       endif
         712             :
         713             :      ! If detrainment was done elsewhere, still update the variables used for output
         714             :      ! assuming that the temperature split between liquid and ice is the same as assumed
         715             :      ! here.
         716           0 :      if (do_detrain) then
         717           0 :         ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 )
         718           0 :         ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1
         719             :       ! dum2                      = dlf(i,k) * ( 1._r8 - dum1 )
         720           0 :         ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / &
         721             :              (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep    Convection
         722             :              3._r8 * (                         dlf2(i,k)    * ( 1._r8 - dum1 ) ) / &
         723           0 :              (4._r8*3.14_r8*10.e-6_r8**3*997._r8)     ! Shallow Convection
         724             :       ! dum2                      = dlf(i,k) * dum1
         725           0 :         ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) *  dum1 ) / &
         726             :              (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep    Convection
         727             :              3._r8 * (                         dlf2(i,k)    *  dum1 ) / &
         728           0 :              (4._r8*3.14_r8*50.e-6_r8**3*500._r8)     ! Shallow Convection
         729           0 :         ptend_loc%s(i,k)          = dlf(i,k) * dum1 * latice
         730             :        else
         731           0 :           ptend_loc%q(i,k,ixcldliq) = 0._r8
         732           0 :           ptend_loc%q(i,k,ixcldice) = 0._r8
         733           0 :           ptend_loc%q(i,k,ixnumliq) = 0._r8
         734           0 :           ptend_loc%q(i,k,ixnumice) = 0._r8
         735           0 :           ptend_loc%s(i,k)          = 0._r8
         736             :      end if
         737             :
         738             :      ! Only rliq is saved from deep convection, which is the reserved liquid.  We need to keep
         739             :      !   track of the integrals of ice and static energy that is effected from conversion to ice
         740             :      !   so that the energy checker doesn't complain.
         741           0 :        det_s(i)                  = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit
         742           0 :        det_ice(i)                = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit
         743             :
         744             :      ! Targetted detrainment of convective liquid water either directly into the
         745             :      ! existing liquid stratus or into the environment.
         746           0 :       if( cu_det_st ) then
         747             :           dlf_T(i,k)  = ptend_loc%s(i,k)/cpair
         748             :           dlf_qv(i,k) = 0._r8
         749             :           dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq)
         750             :           dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice)
         751             :           dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq)
         752             :           dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice)
         753             :           ptend_loc%q(i,k,ixcldliq) = 0._r8
         754             :           ptend_loc%q(i,k,ixcldice) = 0._r8
         755             :           ptend_loc%q(i,k,ixnumliq) = 0._r8
         756             :           ptend_loc%q(i,k,ixnumice) = 0._r8
         757             :           ptend_loc%s(i,k)          = 0._r8
         758             :           dpdlfliq(i,k)             = 0._r8
         759             :           dpdlfice(i,k)             = 0._r8
         760             :           shdlfliq(i,k)             = 0._r8
         761             :           shdlfice(i,k)             = 0._r8
         762             :           dpdlft  (i,k)             = 0._r8
         763             :           shdlft  (i,k)             = 0._r8
         764             :        else
         765           0 :           dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 )
         766           0 :           dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 )
         767           0 :           dpdlft  (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair
         768             :
         769           0 :           shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 )
         770           0 :           shdlfice(i,k) = dlf2(i,k) * ( dum1 )
         771           0 :           shdlft  (i,k) = dlf2(i,k) * dum1 * latice/cpair
         772             :       endif
         773             :    end do
         774             :    end do
         775             :
         776           0 :    call outfld( 'DPDLFLIQ ', dpdlfliq, pcols, lchnk )
         777           0 :    call outfld( 'DPDLFICE ', dpdlfice, pcols, lchnk )
         778           0 :    call outfld( 'SHDLFLIQ ', shdlfliq, pcols, lchnk )
         779           0 :    call outfld( 'SHDLFICE ', shdlfice, pcols, lchnk )
         780           0 :    call outfld( 'DPDLFT   ', dpdlft  , pcols, lchnk )
         781           0 :    call outfld( 'SHDLFT   ', shdlft  , pcols, lchnk )
         782             :
         783           0 :    call outfld( 'ZMDLF',     dlf     , pcols, state_loc%lchnk )
         784             :
         785           0 :    det_ice(:ncol) = det_ice(:ncol)/1000._r8  ! divide by density of water
         786             :
         787             :    ! Add the detrainment tendency to the output tendency
         788           0 :    call physics_ptend_init(ptend, state%psetcols, 'macrop')
         789           0 :    call physics_ptend_sum(ptend_loc, ptend, ncol)
         790             :
         791             :    ! update local copy of state with the detrainment tendency
         792             :    ! ptend_loc is reset to zero by this call
         793           0 :    call physics_update(state_loc, ptend_loc, dtime)
         794             :
         795             :    ! -------------------------------------- !
         796             :    ! Computation of Various Cloud Fractions !
         797             :    ! -------------------------------------- !
         798             :
         799             :    ! ----------------------------------------------------------------------------- !
         800             :    ! Treatment of cloud fraction in CAM4 and CAM5 differs                          !
         801             :    ! (1) CAM4                                                                      !
         802             :    !     . Cumulus AMT = Deep    Cumulus AMT ( empirical fcn of mass flux ) +      !
         803             :    !                     Shallow Cumulus AMT ( empirical fcn of mass flux )        !
         804             :    !     . Stratus AMT = max( RH stratus AMT, Stability Stratus AMT )              !
         805             :    !     . Cumulus and Stratus are 'minimally' overlapped without hierarchy.       !
         806             :    !     . Cumulus LWC,IWC is assumed to be the same as Stratus LWC,IWC            !
         807             :    ! (2) CAM5                                                                      !
         808             :    !     . Cumulus AMT = Deep    Cumulus AMT ( empirical fcn of mass flux ) +      !
         809             :    !                     Shallow Cumulus AMT ( internally fcn of mass flux and w ) !
         810             :    !     . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus )     !
         811             :    !     . Cumulus and Stratus are non-overlapped with higher priority on Cumulus  !
         812             :    !     . Cumulus ( both Deep and Shallow ) has its own LWC and IWC.              !
         813             :    ! ----------------------------------------------------------------------------- !
         814             :
         815           0 :    concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver)
         816             :
         817           0 :    nullify(tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det)
         818           0 :    if (tke_idx      > 0) call pbuf_get_field(pbuf, tke_idx, tke)
         819           0 :    if (qtl_flx_idx  > 0) call pbuf_get_field(pbuf, qtl_flx_idx,  qtl_flx)
         820           0 :    if (qti_flx_idx  > 0) call pbuf_get_field(pbuf, qti_flx_idx,  qti_flx)
         821           0 :    if (cmfr_det_idx > 0) call pbuf_get_field(pbuf, cmfr_det_idx, cmfr_det)
         822           0 :    if (qlr_det_idx  > 0) call pbuf_get_field(pbuf, qlr_det_idx,  qlr_det)
         823           0 :    if (qir_det_idx  > 0) call pbuf_get_field(pbuf, qir_det_idx,  qir_det)
         824             :
         825           0 :    clrw_old(:ncol,:top_lev-1) = 0._r8
         826           0 :    clri_old(:ncol,:top_lev-1) = 0._r8
         827           0 :    do k = top_lev, pver
         828           0 :       do i = 1, ncol
         829           0 :          clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) )
         830           0 :          clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) -  ast(i,k) ) )
         831             :       end do
         832             :    end do
         833             :
         834           0 :    if( use_shfrc ) then
         835           0 :        call pbuf_get_field(pbuf, shfrc_idx, shfrc )
         836             :    else
         837           0 :        allocate(shfrc(pcols,pver))
         838           0 :        shfrc(:,:) = 0._r8
         839             :    endif
         840             :
         841             :    ! CAM5 only uses 'concld' output from the below subroutine.
         842             :    ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld')
         843             :    ! will be computed using this updated 'concld' in the stratiform macrophysics
         844             :    ! scheme (mmacro_pcond) later below.
         845             :
         846           0 :    call t_startf("cldfrc")
         847             :
         848             :    call cldfrc( lchnk, ncol, pbuf,                                                 &
         849             :                 state_loc%pmid, state_loc%t, state_loc%q(:,:,1), state_loc%omega,  &
         850             :                 state_loc%phis, shfrc, use_shfrc,                                  &
         851             :                 cld, rhcloud, clc, state_loc%pdel,                                 &
         852             :                 cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst,                    &
         853             :                 ts, sst, state_loc%pint(:,pverp), zdu, ocnfrac, rhu00,             &
         854             :                 state_loc%q(:,:,ixcldice), icecldf, liqcldf,                       &
         855           0 :                 relhum, 0 )
         856             :
         857           0 :    call t_stopf("cldfrc")
         858             :
         859             :    ! ---------------------------------------------- !
         860             :    ! Stratiform Cloud Macrophysics and Microphysics !
         861             :    ! ---------------------------------------------- !
         862             :
         863           0 :    lchnk  = state_loc%lchnk
         864           0 :    ncol   = state_loc%ncol
         865           0 :    rdtime = 1._r8/dtime
         866             :
         867             :  ! Define fractional amount of stratus condensate and precipitation in ice phase.
         868             :  ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ).
         869             :  ! The ramp within convective cloud may be different
         870             :
         871             : !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists
         872           0 :    fice(:,:) = 0._r8
         873           0 :    fsnow(:,:) = 0._r8
         874             : !REMOVECAM_END
         875           0 :    call cldfrc_fice( ncol, state_loc%t(:ncol,:), fice(:ncol,:), fsnow(:ncol,:) )
         876             :
         877             :
         878           0 :    lq(:)        = .FALSE.
         879             :
         880           0 :    lq(1)        = .true.
         881           0 :    lq(ixcldice) = .true.
         882           0 :    lq(ixcldliq) = .true.
         883             :
         884           0 :    lq(ixnumliq) = .true.
         885           0 :    lq(ixnumice) = .true.
         886             :
         887             :    ! Initialize local physics_ptend object again
         888             :    call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', &
         889           0 :         ls=.true., lq=lq )
         890             :
         891             :  ! --------------------------------- !
         892             :  ! Liquid Macrop_Driver Macrophysics !
         893             :  ! --------------------------------- !
         894             :
         895           0 :    call t_startf('mmacro_pcond')
         896             :
         897           0 :    zeros(:ncol,top_lev:pver)  = 0._r8
         898           0 :    qc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldliq)
         899           0 :    qi(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldice)
         900           0 :    nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq)
         901           0 :    ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice)
         902             :
         903             :  ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... )
         904             :  ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an
         905             :  ! attempt to resolve in-cloud and out-cloud forcings.
         906             :
         907           0 :    if( get_nstep() .le. 1 ) then
         908           0 :        tcwat(:ncol,top_lev:pver)   = state_loc%t(:ncol,top_lev:pver)
         909           0 :        qcwat(:ncol,top_lev:pver)   = state_loc%q(:ncol,top_lev:pver,1)
         910           0 :        lcwat(:ncol,top_lev:pver)   = qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver)
         911           0 :        iccwat(:ncol,top_lev:pver)  = qi(:ncol,top_lev:pver)
         912           0 :        nlwat(:ncol,top_lev:pver)   = nc(:ncol,top_lev:pver)
         913           0 :        niwat(:ncol,top_lev:pver)   = ni(:ncol,top_lev:pver)
         914           0 :        ttend(:ncol,:)   = 0._r8
         915           0 :        qtend(:ncol,:)   = 0._r8
         916           0 :        ltend(:ncol,:)   = 0._r8
         917           0 :        itend(:ncol,:)   = 0._r8
         918           0 :        nltend(:ncol,:)  = 0._r8
         919           0 :        nitend(:ncol,:)  = 0._r8
         920           0 :        CC_T(:ncol,:)    = 0._r8
         921           0 :        CC_qv(:ncol,:)   = 0._r8
         922           0 :        CC_ql(:ncol,:)   = 0._r8
         923           0 :        CC_qi(:ncol,:)   = 0._r8
         924           0 :        CC_nl(:ncol,:)   = 0._r8
         925           0 :        CC_ni(:ncol,:)   = 0._r8
         926           0 :        CC_qlst(:ncol,:) = 0._r8
         927             :    else
         928           0 :        ttend(:ncol,top_lev:pver)   = ( state_loc%t(:ncol,top_lev:pver)   -  tcwat(:ncol,top_lev:pver)) * rdtime &
         929           0 :             - CC_T(:ncol,top_lev:pver)
         930           0 :        qtend(:ncol,top_lev:pver)   = ( state_loc%q(:ncol,top_lev:pver,1) -  qcwat(:ncol,top_lev:pver)) * rdtime &
         931           0 :             - CC_qv(:ncol,top_lev:pver)
         932           0 :        ltend(:ncol,top_lev:pver)   = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime &
         933           0 :             - (CC_ql(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver))
         934           0 :        itend(:ncol,top_lev:pver)   = ( qi(:ncol,top_lev:pver)         - iccwat(:ncol,top_lev:pver)) * rdtime &
         935           0 :             - CC_qi(:ncol,top_lev:pver)
         936           0 :        nltend(:ncol,top_lev:pver)  = ( nc(:ncol,top_lev:pver)         -  nlwat(:ncol,top_lev:pver)) * rdtime &
         937           0 :             - CC_nl(:ncol,top_lev:pver)
         938           0 :        nitend(:ncol,top_lev:pver)  = ( ni(:ncol,top_lev:pver)         -  niwat(:ncol,top_lev:pver)) * rdtime &
         939           0 :             - CC_ni(:ncol,top_lev:pver)
         940             :    endif
         941           0 :    lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver)
         942             :
         943           0 :    t_inout(:ncol,top_lev:pver)  =  tcwat(:ncol,top_lev:pver)
         944           0 :    qv_inout(:ncol,top_lev:pver) =  qcwat(:ncol,top_lev:pver)
         945           0 :    ql_inout(:ncol,top_lev:pver) =  lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)
         946           0 :    qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver)
         947           0 :    nl_inout(:ncol,top_lev:pver) =  nlwat(:ncol,top_lev:pver)
         948           0 :    ni_inout(:ncol,top_lev:pver) =  niwat(:ncol,top_lev:pver)
         949             :
         950             :  ! Liquid Microp_Driver Macrophysics.
         951             :  ! The main roles of this subroutines are
         952             :  ! (1) compute net condensation rate of stratiform liquid ( cmeliq )
         953             :  ! (2) compute liquid stratus and ice stratus fractions.
         954             :  ! Note 'ttend...' are advective tendencies except microphysical process while
         955             :  !      'CC...'    are microphysical tendencies.
         956             :
         957             :    call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel,        &
         958             :                       t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, &
         959             :                       ttend, qtend, lmitend, itend, nltend, nitend,              &
         960             :                       CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst,          &
         961             :                       dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni,             &
         962             :                       concld_old, concld, clrw_old, clri_old, landfrac, snowh,   &
         963             :                       tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det,         &
         964             :                       tlat, qvlat, qcten, qiten, ncten, niten,                   &
         965             :                       cmeliq, qvadj, qladj, qiadj, qllim, qilim,                 &
         966           0 :                       cld, alst, aist, qlst, qist, do_cldice )
         967             :
         968             :  ! Copy of concld/fice to put in physics buffer
         969             :  ! Below are used only for convective cloud.
         970             :
         971           0 :    fice_ql(:ncol,:top_lev-1)     = 0._r8
         972           0 :    fice_ql(:ncol,top_lev:pver)   = fice(:ncol,top_lev:pver)
         973             :
         974             :
         975             :  ! Compute net stratus fraction using maximum over-lapping assumption
         976           0 :    ast(:ncol,:top_lev-1) = 0._r8
         977           0 :    ast(:ncol,top_lev:pver) = max( alst(:ncol,top_lev:pver), aist(:ncol,top_lev:pver) )
         978             :
         979           0 :    call t_stopf('mmacro_pcond')
         980             :
         981           0 :    do k = top_lev, pver
         982           0 :       do i = 1, ncol
         983           0 :          ptend_loc%s(i,k)          =  tlat(i,k)
         984           0 :          ptend_loc%q(i,k,1)        = qvlat(i,k)
         985           0 :          ptend_loc%q(i,k,ixcldliq) = qcten(i,k)
         986           0 :          ptend_loc%q(i,k,ixcldice) = qiten(i,k)
         987           0 :          ptend_loc%q(i,k,ixnumliq) = ncten(i,k)
         988           0 :          ptend_loc%q(i,k,ixnumice) = niten(i,k)
         989             :
         990             :          ! Check to make sure that the macrophysics code is respecting the flags that control
         991             :          ! whether cldwat should be prognosing cloud ice and cloud liquid or not.
         992           0 :          if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then
         993             :             call endrun("macrop_driver:ERROR - "// &
         994           0 :                  "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.")
         995             :          end if
         996           0 :          if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then
         997             :             call endrun("macrop_driver:ERROR -"// &
         998           0 :                  " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.")
         999             :          end if
        1000             :
        1001           0 :          if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then
        1002             :             call endrun("macrop_driver:ERROR - "// &
        1003           0 :                  "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.")
        1004             :          end if
        1005           0 :          if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then
        1006             :             call endrun("macrop_driver:ERROR - "// &
        1007           0 :                  "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.")
        1008             :          end if
        1009             :       end do
        1010             :    end do
        1011             :
        1012             :    ! update the output tendencies with the mmacro_pcond tendencies
        1013           0 :    call physics_ptend_sum(ptend_loc, ptend, ncol)
        1014             :
        1015             :    ! state_loc is the equlibrium state after macrophysics
        1016           0 :    call physics_update(state_loc, ptend_loc, dtime)
        1017             :
        1018           0 :    call outfld('CLR_LIQ', clrw_old,  pcols, lchnk)
        1019           0 :    call outfld('CLR_ICE', clri_old,  pcols, lchnk)
        1020             :
        1021           0 :    call outfld( 'MACPDT   ', tlat ,  pcols, lchnk )
        1022           0 :    call outfld( 'MACPDQ   ', qvlat,  pcols, lchnk )
        1023           0 :    call outfld( 'MACPDLIQ ', qcten,  pcols, lchnk )
        1024           0 :    call outfld( 'MACPDICE ', qiten,  pcols, lchnk )
        1025           0 :    call outfld( 'CLDVAPADJ', qvadj,  pcols, lchnk )
        1026           0 :    call outfld( 'CLDLIQADJ', qladj,  pcols, lchnk )
        1027           0 :    call outfld( 'CLDICEADJ', qiadj,  pcols, lchnk )
        1028           0 :    call outfld( 'CLDLIQDET', dlf_ql, pcols, lchnk )
        1029           0 :    call outfld( 'CLDICEDET', dlf_qi, pcols, lchnk )
        1030           0 :    call outfld( 'CLDLIQLIM', qllim,  pcols, lchnk )
        1031           0 :    call outfld( 'CLDICELIM', qilim,  pcols, lchnk )
        1032             :
        1033           0 :    call outfld( 'ICECLDF ', aist,   pcols, lchnk )
        1034           0 :    call outfld( 'LIQCLDF ', alst,   pcols, lchnk )
        1035           0 :    call outfld( 'AST',      ast,    pcols, lchnk )
        1036             :
        1037           0 :    call outfld( 'CONCLD  ', concld, pcols, lchnk )
        1038           0 :    call outfld( 'CLDST   ', cldst,  pcols, lchnk )
        1039             :
        1040           0 :    call outfld( 'CMELIQ'  , cmeliq, pcols, lchnk )
        1041             :
        1042             :
        1043             :    ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP
        1044             :
        1045             :    ! initialize local variables
        1046           0 :    mr_ccliq = 0._r8   !! not seen by radiation, so setting to 0
        1047           0 :    mr_ccice = 0._r8   !! not seen by radiation, so setting to 0
        1048           0 :    mr_lsliq = 0._r8
        1049           0 :    mr_lsice = 0._r8
        1050             :
        1051           0 :    do k=top_lev,pver
        1052           0 :       do i=1,ncol
        1053           0 :          if (cld(i,k) .gt. 0._r8) then
        1054           0 :             mr_lsliq(i,k) = state_loc%q(i,k,ixcldliq)
        1055           0 :             mr_lsice(i,k) = state_loc%q(i,k,ixcldice)
        1056             :          else
        1057           0 :             mr_lsliq(i,k) = 0._r8
        1058           0 :             mr_lsice(i,k) = 0._r8
        1059             :          end if
        1060             :       end do
        1061             :    end do
        1062             :
        1063           0 :    call outfld( 'CLDLIQSTR  ', mr_lsliq,    pcols, lchnk )
        1064           0 :    call outfld( 'CLDICESTR  ', mr_lsice,    pcols, lchnk )
        1065           0 :    call outfld( 'CLDLIQCON  ', mr_ccliq,    pcols, lchnk )
        1066           0 :    call outfld( 'CLDICECON  ', mr_ccice,    pcols, lchnk )
        1067             :
        1068             :    ! ------------------------------------------------- !
        1069             :    ! Save equilibrium state variables for macrophysics !
        1070             :    ! at the next time step                             !
        1071             :    ! ------------------------------------------------- !
        1072           0 :    cldsice = 0._r8
        1073           0 :    do k = top_lev, pver
        1074           0 :       tcwat(:ncol,k)  = state_loc%t(:ncol,k)
        1075           0 :       qcwat(:ncol,k)  = state_loc%q(:ncol,k,1)
        1076           0 :       lcwat(:ncol,k)  = state_loc%q(:ncol,k,ixcldliq) + state_loc%q(:ncol,k,ixcldice)
        1077           0 :       iccwat(:ncol,k) = state_loc%q(:ncol,k,ixcldice)
        1078           0 :       nlwat(:ncol,k)  = state_loc%q(:ncol,k,ixnumliq)
        1079           0 :       niwat(:ncol,k)  = state_loc%q(:ncol,k,ixnumice)
        1080           0 :       cldsice(:ncol,k) = lcwat(:ncol,k) * min(1.0_r8, max(0.0_r8, (tmelt - tcwat(:ncol,k)) / 20._r8))
        1081             :    end do
        1082             :
        1083           0 :    call outfld( 'CLDSICE'    , cldsice,   pcols, lchnk )
        1084             :
        1085             :    ! ptend_loc is deallocated in physics_update above
        1086           0 :    call physics_state_dealloc(state_loc)
        1087             :
        1088           0 : end subroutine macrop_driver_tend
        1089             :
        1090             :
        1091             : ! Saturation adjustment for liquid
        1092             : !
        1093             : ! With CLUBB, we are seeing relative humidity with respect to water
        1094             : ! greater than 1. This should not be happening and is not what the
        1095             : ! microphsyics expects from the macrophysics. As a work around while
        1096             : ! this issue is investigated in CLUBB, this routine will enfornce a
        1097             : ! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will
        1098             : ! be converted into cloud drops.
        1099           0 : subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend,vlen)
        1100             :
        1101           0 :   use wv_sat_methods, only: wv_sat_qsat_ice_vect, wv_sat_qsat_water_vect
        1102             :   use micro_pumas_utils, only: rhow
        1103             :   use physconst,      only: rair
        1104             :   use cldfrc2m,       only: rhmini_const, rhmaxi_const
        1105             :
        1106             :   integer,                   intent(in)  :: vlen
        1107             :   real(r8), dimension(vlen), intent(in)  :: npccn  !Activated number of cloud condensation nuclei
        1108             :   real(r8), dimension(vlen), intent(in)  :: t      !temperature (k)
        1109             :   real(r8), dimension(vlen), intent(in)  :: p      !pressure (pa)
        1110             :   real(r8), dimension(vlen), intent(in)  :: qv     !water vapor mixing ratio
        1111             :   real(r8), dimension(vlen), intent(in)  :: qc     !liquid mixing ratio
        1112             :   real(r8), dimension(vlen), intent(in)  :: nc     !liquid number concentration
        1113             :   real(r8),                  intent(in)  :: xxlv   !latent heat of vaporization
        1114             :   real(r8),                  intent(in)  :: deltat !timestep
        1115             :   real(r8), dimension(vlen), intent(out) :: stend  ! 'temperature' tendency
        1116             :   real(r8), dimension(vlen), intent(out) :: qvtend !vapor tendency
        1117             :   real(r8), dimension(vlen), intent(out) :: qctend !liquid mass tendency
        1118             :   real(r8), dimension(vlen), intent(out) :: nctend !liquid number tendency
        1119             :
        1120           0 :   real(r8) :: ESL(vlen)
        1121           0 :   real(r8) :: QSL(vlen)
        1122             :   real(r8) :: drop_size_param
        1123             :   integer  :: i
        1124             :
        1125           0 :   drop_size_param = 3._r8/(4._r8*3.14_r8*6.e-6_r8**3*rhow)
        1126             :
        1127           0 :   do i = 1, vlen
        1128           0 :      stend(i) = 0._r8
        1129           0 :      qvtend(i) = 0._r8
        1130           0 :      qctend(i) = 0._r8
        1131           0 :      nctend(i) = 0._r8
        1132             :   end do
        1133             :
        1134             :   ! calculate qsatl from t,p,q
        1135             :   !$acc data copyin(t,p) copyout(ESL,QSL)
        1136           0 :   call wv_sat_qsat_water_vect(t, p, ESL, QSL, vlen)
        1137             :   !$acc end data
        1138             :
        1139           0 :   do i = 1, vlen
        1140             :      ! Don't allow supersaturation with respect to liquid.
        1141           0 :      if (qv(i) > QSL(i)) then
        1142             :
        1143           0 :         qctend(i) = (qv(i) - QSL(i)) / deltat
        1144           0 :         qvtend(i) = 0._r8 - qctend(i)
        1145           0 :         stend(i)  = qctend(i) * xxlv    ! moist static energy tend...[J/kg/s] !
        1146             :
        1147             :         ! If drops  exists (more than 1 L-1) and there is condensation,
        1148             :         ! do not add to number (= growth), otherwise  add 6um drops.
        1149             :         !
        1150             :         ! This is somewhat arbitrary, but ensures that some reasonable droplet
        1151             :         ! size is created to remove the excess water. This could be enhanced to
        1152             :         ! look at npccn, but ideally this entire routine should go away.
        1153           0 :         if ((nc(i)*p(i)/rair/t(i) < 1e3_r8) .and. (qc(i)+qctend(i)*deltat > 1e-18_r8)) then
        1154           0 :            nctend(i) = nctend(i) + qctend(i)*drop_size_param
        1155             :         end if
        1156             :      end if
        1157             :   end do
        1158             :
        1159           0 : end subroutine liquid_macro_tend
        1160             :
        1161             : end module macrop_driver

Generated by: LCOV version 1.14