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 179568 : 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 89784 : deep_scheme_does_scav_trans = .false.
65 :
66 89784 : 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 2304 : 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 2304 : call phys_getopts(deep_scheme_out = deep_scheme)
90 :
91 2304 : select case ( deep_scheme )
92 : case('ZM') ! Zhang-McFarlane (default)
93 2304 : 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 2304 : 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 2304 : if (use_gw_convect_dp .and. deep_scheme == 'ZM') then
106 2304 : call pbuf_add_field('TTEND_DP','physpkg',dtype_r8,(/pcols,pver/),ttend_dp_idx)
107 : end if
108 :
109 2304 : end subroutine convect_deep_register
110 :
111 : !=========================================================================================
112 :
113 :
114 :
115 2304 : subroutine convect_deep_init(pref_edge)
116 :
117 : !----------------------------------------
118 : ! Purpose: declare output fields, initialize variables needed by convection
119 : !----------------------------------------
120 :
121 2304 : 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 2304 : if (masterproc) write(iulog,*)'convect_deep initializing Zhang-McFarlane convection'
140 2304 : call zm_conv_init(pref_edge)
141 : case('UNICON')
142 0 : if (masterproc) write(iulog,*)'convect_deep: deep convection done by UNICON'
143 : case default
144 2304 : if (masterproc) write(iulog,*)'WARNING: convect_deep: no deep convection scheme. May fail.'
145 : end select
146 :
147 2304 : icwmrdp_idx = pbuf_get_index('ICWMRDP')
148 2304 : rprddp_idx = pbuf_get_index('RPRDDP')
149 2304 : nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU')
150 2304 : prec_dp_idx = pbuf_get_index('PREC_DP')
151 2304 : snow_dp_idx = pbuf_get_index('SNOW_DP')
152 :
153 2304 : cldtop_idx = pbuf_get_index('CLDTOP')
154 2304 : cldbot_idx = pbuf_get_index('CLDBOT')
155 2304 : cld_idx = pbuf_get_index('CLD')
156 2304 : fracis_idx = pbuf_get_index('FRACIS')
157 :
158 2304 : pblh_idx = pbuf_get_index('pblh')
159 2304 : tpert_idx = pbuf_get_index('tpert')
160 :
161 4608 : call addfld ('ICWMRDP', (/ 'lev' /), 'A', 'kg/kg', 'Deep Convection in-cloud water mixing ratio ' )
162 :
163 2304 : end subroutine convect_deep_init
164 : !=========================================================================================
165 : !subroutine convect_deep_tend(state, ptend, tdt, pbuf)
166 :
167 4161024 : subroutine convect_deep_tend( &
168 : mcon ,cme , &
169 : zdu , &
170 : rliq ,rice , &
171 : ztodt , &
172 : state ,ptend ,landfrac ,pbuf)
173 :
174 :
175 2304 : use physics_types, only: physics_state, physics_ptend, physics_tend, physics_ptend_init
176 :
177 : use cam_history, only: outfld
178 : use constituents, only: pcnst
179 : use zm_conv_intr, only: zm_conv_tend
180 : use cam_history, only: outfld
181 : use physconst, only: cpair
182 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field
183 :
184 : ! Arguments
185 : type(physics_state), intent(in ) :: state ! Physics state variables
186 : type(physics_ptend), intent(out) :: ptend ! individual parameterization tendencies
187 :
188 :
189 : type(physics_buffer_desc), pointer :: pbuf(:)
190 : real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
191 : real(r8), intent(in) :: landfrac(pcols) ! Land fraction
192 :
193 :
194 : real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c
195 : real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation
196 : real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux
197 :
198 : real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
199 : real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals
200 :
201 99072 : real(r8), pointer :: prec(:) ! total precipitation
202 99072 : real(r8), pointer :: snow(:) ! snow from ZM convection
203 :
204 99072 : real(r8), pointer, dimension(:) :: jctop
205 99072 : real(r8), pointer, dimension(:) :: jcbot
206 99072 : real(r8), pointer, dimension(:,:,:) :: cld
207 99072 : real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water.
208 99072 : real(r8), pointer, dimension(:,:) :: rprd ! rain production rate
209 99072 : real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
210 :
211 99072 : real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation
212 :
213 99072 : real(r8), pointer :: pblh(:) ! Planetary boundary layer height
214 99072 : real(r8), pointer :: tpert(:) ! Thermal temperature excess
215 :
216 : ! Temperature tendency from deep convection (pbuf pointer).
217 99072 : real(r8), pointer, dimension(:,:) :: ttend_dp
218 :
219 : real(r8) zero(pcols, pver)
220 :
221 : integer i, k
222 :
223 99072 : call pbuf_get_field(pbuf, cldtop_idx, jctop )
224 99072 : call pbuf_get_field(pbuf, cldbot_idx, jcbot )
225 99072 : call pbuf_get_field(pbuf, icwmrdp_idx, ql )
226 :
227 0 : select case ( deep_scheme )
228 : case('off', 'UNICON', 'CLUBB_SGS') ! in UNICON case the run method is called from convect_shallow_tend
229 0 : zero = 0
230 0 : mcon = 0
231 0 : cme = 0
232 0 : zdu = 0
233 0 : rliq = 0
234 0 : rice = 0
235 :
236 0 : call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
237 :
238 : !
239 : ! Associate pointers with physics buffer fields
240 : !
241 :
242 0 : call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1/), kount=(/pcols,pver/) )
243 0 : call pbuf_get_field(pbuf, rprddp_idx, rprd )
244 0 : call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
245 0 : call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
246 0 : call pbuf_get_field(pbuf, prec_dp_idx, prec )
247 0 : call pbuf_get_field(pbuf, snow_dp_idx, snow )
248 :
249 0 : prec=0
250 0 : snow=0
251 :
252 0 : jctop = pver
253 0 : jcbot = 1._r8
254 0 : cld = 0
255 0 : ql = 0
256 0 : rprd = 0
257 0 : fracis = 0
258 0 : evapcdp = 0
259 :
260 : case('ZM') ! 1 ==> Zhang-McFarlane (default)
261 99072 : call pbuf_get_field(pbuf, pblh_idx, pblh)
262 99072 : call pbuf_get_field(pbuf, tpert_idx, tpert)
263 :
264 : call zm_conv_tend( pblh ,mcon ,cme , &
265 : tpert ,zdu , &
266 : rliq ,rice , &
267 : ztodt , &
268 : jctop, jcbot , &
269 198144 : state ,ptend ,landfrac, pbuf)
270 :
271 : end select
272 :
273 : ! If we added temperature tendency to pbuf, set it now.
274 :
275 99072 : if (ttend_dp_idx > 0) then
276 99072 : call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp)
277 153946368 : ttend_dp(:state%ncol,:pver) = ptend%s(:state%ncol,:pver)/cpair
278 : end if
279 :
280 99072 : call outfld( 'ICWMRDP ', ql , pcols, state%lchnk )
281 :
282 198144 : end subroutine convect_deep_tend
283 : !=========================================================================================
284 :
285 :
286 3770928 : subroutine convect_deep_tend_2( state, ptend, ztodt, pbuf)
287 :
288 99072 : use physics_types, only: physics_state, physics_ptend, physics_ptend_init
289 :
290 : use physics_buffer, only: physics_buffer_desc
291 : use constituents, only: pcnst
292 : use zm_conv_intr, only: zm_conv_tend_2
293 :
294 : ! Arguments
295 : type(physics_state), intent(in ) :: state ! Physics state variables
296 : type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
297 :
298 : type(physics_buffer_desc), pointer :: pbuf(:)
299 :
300 : real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
301 :
302 :
303 89784 : if ( deep_scheme .eq. 'ZM' ) then ! Zhang-McFarlane
304 89784 : call zm_conv_tend_2( state, ptend, ztodt, pbuf)
305 : else
306 0 : call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
307 : end if
308 :
309 :
310 89784 : end subroutine convect_deep_tend_2
311 :
312 :
313 : end module convect_deep
|
