Line data Source code
1 :
2 : module convect_deep
3 : !---------------------------------------------------------------------------------
4 : ! Purpose:
5 : !
6 : ! CAM interface to several deep convection interfaces. Currently includes:
7 : ! Zhang-McFarlane (default)
8 : ! Kerry Emanuel
9 : !
10 : !
11 : ! Author: D.B. Coleman, Sep 2004
12 : !
13 : !---------------------------------------------------------------------------------
14 : use shr_kind_mod, only: r8=>shr_kind_r8
15 : use ppgrid, only: pver, pcols, pverp
16 : use cam_logfile, only: iulog
17 :
18 : implicit none
19 :
20 : save
21 : private ! Make default type private to the module
22 :
23 : ! Public methods
24 :
25 : public ::&
26 : convect_deep_register, &! register fields in physics buffer
27 : convect_deep_init, &! initialize donner_deep module
28 : convect_deep_tend, &! return tendencies
29 : convect_deep_tend_2, &! return tendencies
30 : deep_scheme_does_scav_trans ! = .t. if scheme does scavenging and conv. transport
31 :
32 : ! Private module data
33 : character(len=16) :: deep_scheme ! default set in phys_control.F90, use namelist to change
34 : ! Physics buffer indices
35 : integer :: icwmrdp_idx = 0
36 : integer :: rprddp_idx = 0
37 : integer :: nevapr_dpcu_idx = 0
38 : integer :: cldtop_idx = 0
39 : integer :: cldbot_idx = 0
40 : integer :: cld_idx = 0
41 : integer :: fracis_idx = 0
42 :
43 : integer :: pblh_idx = 0
44 : integer :: tpert_idx = 0
45 : integer :: prec_dp_idx = 0
46 : integer :: snow_dp_idx = 0
47 :
48 : integer :: ttend_dp_idx = 0
49 :
50 : !=========================================================================================
51 : contains
52 :
53 : !=========================================================================================
54 2978352 : function deep_scheme_does_scav_trans()
55 : !
56 : ! Function called by tphysbc to determine if it needs to do scavenging and convective transport
57 : ! or if those have been done by the deep convection scheme. Each scheme could have its own
58 : ! identical query function for a less-knowledgable interface but for now, we know that KE
59 : ! does scavenging & transport, and ZM doesn't
60 : !
61 :
62 : logical deep_scheme_does_scav_trans
63 :
64 1489176 : deep_scheme_does_scav_trans = .false.
65 :
66 1489176 : if ( deep_scheme .eq. 'KE' ) deep_scheme_does_scav_trans = .true.
67 :
68 : return
69 :
70 : end function deep_scheme_does_scav_trans
71 :
72 : !=========================================================================================
73 1536 : subroutine convect_deep_register
74 :
75 : !----------------------------------------
76 : ! Purpose: register fields with the physics buffer
77 : !----------------------------------------
78 :
79 :
80 : use physics_buffer, only : pbuf_add_field, dtype_r8
81 : use zm_conv_intr, only: zm_conv_register
82 : use phys_control, only: phys_getopts, use_gw_convect_dp
83 :
84 : implicit none
85 :
86 : integer idx
87 :
88 : ! get deep_scheme setting from phys_control
89 1536 : call phys_getopts(deep_scheme_out = deep_scheme)
90 :
91 1536 : select case ( deep_scheme )
92 : case('ZM') ! Zhang-McFarlane (default)
93 1536 : call zm_conv_register
94 :
95 : case('off', 'UNICON') ! Off needs to setup the following fields
96 0 : call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx)
97 0 : call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx)
98 0 : call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx)
99 0 : call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx)
100 1536 : call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx)
101 :
102 : end select
103 :
104 : ! If gravity waves from deep convection are on, output this field.
105 1536 : if (use_gw_convect_dp .and. deep_scheme == 'ZM') then
106 1536 : call pbuf_add_field('TTEND_DP','physpkg',dtype_r8,(/pcols,pver/),ttend_dp_idx)
107 : end if
108 :
109 1536 : end subroutine convect_deep_register
110 :
111 : !=========================================================================================
112 :
113 :
114 :
115 1536 : subroutine convect_deep_init(pref_edge)
116 :
117 : !----------------------------------------
118 : ! Purpose: declare output fields, initialize variables needed by convection
119 : !----------------------------------------
120 :
121 1536 : use cam_history, only: addfld
122 : use pmgrid, only: plevp
123 : use spmd_utils, only: masterproc
124 : use zm_conv_intr, only: zm_conv_init
125 : use cam_abortutils, only: endrun
126 :
127 : use physics_buffer, only: physics_buffer_desc, pbuf_get_index
128 :
129 : implicit none
130 :
131 : real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces
132 :
133 0 : select case ( deep_scheme )
134 : case('off')
135 0 : if (masterproc) write(iulog,*)'convect_deep: no deep convection selected'
136 : case('CLUBB_SGS')
137 0 : if (masterproc) write(iulog,*)'convect_deep: CLUBB_SGS selected'
138 : case('ZM')
139 1536 : if (masterproc) write(iulog,*)'convect_deep initializing Zhang-McFarlane convection'
140 1536 : call zm_conv_init(pref_edge)
141 : case('UNICON')
142 0 : if (masterproc) write(iulog,*)'convect_deep: deep convection done by UNICON'
143 : case('SPCAM')
144 0 : if (masterproc) write(iulog,*)'convect_deep: deep convection done by SPCAM'
145 0 : return
146 : case default
147 1536 : if (masterproc) write(iulog,*)'WARNING: convect_deep: no deep convection scheme. May fail.'
148 : end select
149 :
150 1536 : icwmrdp_idx = pbuf_get_index('ICWMRDP')
151 1536 : rprddp_idx = pbuf_get_index('RPRDDP')
152 1536 : nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
153 1536 : prec_dp_idx = pbuf_get_index('PREC_DP')
154 1536 : snow_dp_idx = pbuf_get_index('SNOW_DP')
155 :
156 1536 : cldtop_idx = pbuf_get_index('CLDTOP')
157 1536 : cldbot_idx = pbuf_get_index('CLDBOT')
158 1536 : cld_idx = pbuf_get_index('CLD')
159 1536 : fracis_idx = pbuf_get_index('FRACIS')
160 :
161 1536 : pblh_idx = pbuf_get_index('pblh')
162 1536 : tpert_idx = pbuf_get_index('tpert')
163 :
164 3072 : call addfld ('ICWMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Deep Convection in-cloud water mixing ratio ' )
165 :
166 1536 : end subroutine convect_deep_init
167 : !=========================================================================================
168 : !subroutine convect_deep_tend(state, ptend, tdt, pbuf)
169 :
170 62805456 : subroutine convect_deep_tend( &
171 : mcon ,cme , &
172 : zdu , &
173 : rliq ,rice , &
174 : ztodt , &
175 : state ,ptend ,landfrac ,pbuf)
176 :
177 :
178 1536 : use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init
179 :
180 : use cam_history, only: outfld
181 : use constituents, only: pcnst
182 : use zm_conv_intr, only: zm_conv_tend
183 : use cam_history, only: outfld
184 : use physconst, only: cpair
185 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field
186 :
187 : ! Arguments
188 : type(physics_state), intent(in ) :: state ! Physics state variables
189 : type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies
190 :
191 :
192 : type(physics_buffer_desc), pointer :: pbuf(:)
193 : real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
194 : real(r8), intent(in) :: landfrac(pcols) ! Land fraction
195 :
196 :
197 : real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c
198 : real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation
199 : real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux
200 :
201 : real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
202 : real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals
203 :
204 1495368 : real(r8), pointer :: prec(:) ! total precipitation
205 1495368 : real(r8), pointer :: snow(:) ! snow from ZM convection
206 :
207 1495368 : real(r8), pointer, dimension(:) :: jctop
208 1495368 : real(r8), pointer, dimension(:) :: jcbot
209 1495368 : real(r8), pointer, dimension(:,:,:) :: cld
210 1495368 : real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water.
211 1495368 : real(r8), pointer, dimension(:,:) :: rprd ! rain production rate
212 1495368 : real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
213 :
214 1495368 : real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation
215 :
216 1495368 : real(r8), pointer :: pblh(:) ! Planetary boundary layer height
217 1495368 : real(r8), pointer :: tpert(:) ! Thermal temperature excess
218 :
219 : ! Temperature tendency from deep convection (pbuf pointer).
220 1495368 : real(r8), pointer, dimension(:,:) :: ttend_dp
221 :
222 : real(r8) zero(pcols, pver)
223 :
224 : integer i, k
225 :
226 1495368 : call pbuf_get_field(pbuf, cldtop_idx, jctop )
227 1495368 : call pbuf_get_field(pbuf, cldbot_idx, jcbot )
228 1495368 : call pbuf_get_field(pbuf, icwmrdp_idx, ql )
229 :
230 0 : select case ( deep_scheme )
231 : case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend
232 0 : zero = 0
233 0 : mcon = 0
234 0 : cme = 0
235 0 : zdu = 0
236 0 : rliq = 0
237 0 : rice = 0
238 :
239 0 : call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
240 :
241 : !
242 : ! Associate pointers with physics buffer fields
243 : !
244 :
245 0 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) )
246 0 : call pbuf_get_field(pbuf, rprddp_idx, rprd )
247 0 : call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
248 0 : call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
249 0 : call pbuf_get_field(pbuf, prec_dp_idx, prec )
250 0 : call pbuf_get_field(pbuf, snow_dp_idx, snow )
251 :
252 0 : prec=0
253 0 : snow=0
254 :
255 0 : jctop = pver
256 0 : jcbot = 1._r8
257 0 : cld = 0
258 0 : ql = 0
259 0 : rprd = 0
260 0 : fracis = 0
261 0 : evapcdp = 0
262 :
263 : case('ZM') ! 1 ==> Zhang-McFarlane (default)
264 1495368 : call pbuf_get_field(pbuf, pblh_idx, pblh)
265 1495368 : call pbuf_get_field(pbuf, tpert_idx, tpert)
266 :
267 : call zm_conv_tend( pblh ,mcon ,cme , &
268 : tpert ,zdu , &
269 : rliq ,rice , &
270 : ztodt , &
271 : jctop, jcbot , &
272 2990736 : state ,ptend ,landfrac, pbuf)
273 :
274 : end select
275 :
276 : ! If we added temperature tendency to pbuf, set it now.
277 :
278 1495368 : if (ttend_dp_idx > 0) then
279 1495368 : call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp)
280 2323627992 : ttend_dp(:state%ncol,:pver) = ptend%s(:state%ncol,:pver)/cpair
281 : end if
282 :
283 1495368 : call outfld( 'ICWMRDP ', ql , pcols, state%lchnk )
284 :
285 2990736 : end subroutine convect_deep_tend
286 : !=========================================================================================
287 :
288 :
289 62545392 : subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf)
290 :
291 1495368 : use physics_types, only: physics_state, physics_ptend, physics_ptend_init
292 :
293 : use physics_buffer, only: physics_buffer_desc
294 : use constituents, only: pcnst
295 : use zm_conv_intr, only: zm_conv_tend_2
296 :
297 : ! Arguments
298 : type(physics_state), intent(in ) :: state ! Physics state variables
299 : type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
300 :
301 : type(physics_buffer_desc), pointer :: pbuf(:)
302 :
303 : real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
304 :
305 :
306 1489176 : if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane
307 1489176 : call zm_conv_tend_2( state, ptend, ztodt, pbuf)
308 : else
309 0 : call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
310 : end if
311 :
312 :
313 1489176 : end subroutine convect_deep_tend_2
314 :
315 :
316 : end module convect_deep
|
