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