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