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