← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
mynnedmf_wrapper.F90
1
4
8 MODULE mynnedmf_wrapper
9
10 contains
11
15 subroutine mynnedmf_wrapper_init ( &
16 & con_cp, con_grav, con_rd, con_rv, &
17 & con_cpv, con_cliq, con_cice, con_rcp, &
18 & con_XLV, con_XLF, con_p608, con_ep2, &
19 & con_karman, con_t0c, &
20 & do_mynnedmf, &
21 & errmsg, errflg )
22
23 use machine, only : kind_phys
24 use bl_mynn_common
25
26 implicit none
27
28 logical, intent(in) :: do_mynnedmf
29 character(len=*),intent(out):: errmsg
30 integer, intent(out) :: errflg
31
32 real(kind_phys),intent(in) :: con_xlv
33 real(kind_phys),intent(in) :: con_xlf
34 real(kind_phys),intent(in) :: con_rv
35 real(kind_phys),intent(in) :: con_rd
36 real(kind_phys),intent(in) :: con_ep2
37 real(kind_phys),intent(in) :: con_grav
38 real(kind_phys),intent(in) :: con_cp
39 real(kind_phys),intent(in) :: con_cpv
40 real(kind_phys),intent(in) :: con_rcp
41 real(kind_phys),intent(in) :: con_p608
42 real(kind_phys),intent(in) :: con_cliq
43 real(kind_phys),intent(in) :: con_cice
44 real(kind_phys),intent(in) :: con_karman
45 real(kind_phys),intent(in) :: con_t0c
46
47 ! Initialize CCPP error handling variables
48 errmsg = ''
49 errflg = 0
50
51 xlv = con_xlv
52 xlf = con_xlf
53 r_v = con_rv
54 r_d = con_rd
55 ep_2 = con_ep2
56 grav = con_grav
57 cp = con_cp
58 cpv = con_cpv
59 rcp = con_rcp
60 p608 = con_p608
61 cliq = con_cliq
62 cice = con_cice
63 karman = con_karman
64 t0c = con_t0c
65
66 xls = xlv+xlf != 2.85E6 (J/kg) sublimation
67 rvovrd = r_v/r_d != 1.608
68 ep_3 = 1.-ep_2 != 0.378
69 gtr = grav/tref
70 rk = cp/r_d
71 tv0 = p608*tref
72 tv1 = (1.+p608)*tref
73 xlscp = (xlv+xlf)/cp
74 xlvcp = xlv/cp
75 g_inv = 1./grav
76
77 ! Consistency checks
78 if (.not. do_mynnedmf) then
79 errmsg = 'Logic error: do_mynnedmf = .false.'
80 errflg = 1
81 return
82 end if
83
84 end subroutine mynnedmf_wrapper_init
85
91SUBROUTINE mynnedmf_wrapper_run( &
92 & im,levs, &
93 & flag_init,flag_restart, &
94 & lssav, ldiag3d, qdiag3d, &
95 & lsidea, cplflx, &
96 & delt,dtf,dx,zorl, &
97 & phii,u,v,omega,t3d, &
98 & qgrs_water_vapor, &
99 & qgrs_liquid_cloud, &
100 & qgrs_ice, &
101 & qgrs_snow, &
102 & qgrs_cloud_droplet_num_conc, &
103 & qgrs_cloud_ice_num_conc, &
104 & qgrs_ozone, &
105 & qgrs_water_aer_num_conc, &
106 & qgrs_ice_aer_num_conc, &
107 & qgrs_cccn, &
108 & prsl,prsi,exner, &
109 & slmsk,tsurf,qsfc,ps, &
110 & ust,ch,hflx,qflx,wspd,rb, &
111 & dtsfc1,dqsfc1, &
112 & dusfc1,dvsfc1, &
113 & dusfci_diag,dvsfci_diag, &
114 & dtsfci_diag,dqsfci_diag, &
115 & dusfc_diag,dvsfc_diag, &
116 & dtsfc_diag,dqsfc_diag, &
117 & dusfc_cice,dvsfc_cice, &
118 & dtsfc_cice,dqsfc_cice, &
119 & hflx_wat,qflx_wat,stress_wat, &
120 & oceanfrac,fice,wet,icy,dry, &
121 & dusfci_cpl,dvsfci_cpl, &
122 & dtsfci_cpl,dqsfci_cpl, &
123 & dusfc_cpl,dvsfc_cpl, &
124 & dtsfc_cpl,dqsfc_cpl, &
125 & recmol, &
126 & qke,qke_adv,Tsq,Qsq,Cov, &
127 & el_pbl,sh3d,sm3d,exch_h,exch_m, &
128 & dqke,qwt,qshear,qbuoy,qdiss, &
129 & Pblh,kpbl, &
130 & qc_bl,qi_bl,cldfra_bl, &
131 & edmf_a,edmf_w,edmf_qt, &
132 & edmf_thl,edmf_ent,edmf_qc, &
133 & sub_thl,sub_sqv,det_thl,det_sqv,&
134 & maxwidth,maxMF,ztop_plume, &
135 & ktop_plume, &
136 & dudt, dvdt, dtdt, dqdt_all, &
137 & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw
138 & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw
139 & dqdt_ozone, & ! <=== ntoz
140 & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc
141 & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc,& ! <=== ntwa, ntia
142 & dqdt_cccn, & ! <=== ntccn
143 & tmf, flag_for_pbl_generic_tend, &
144 & dtend, dtidx, index_of_temperature, &
145 & index_of_x_wind, index_of_y_wind, ntke, &
146 & ntqv, ntcw, ntiw, ntsw, &
147 & ntoz, ntlnc, ntinc, ntwa, ntia, &
148 & index_of_process_pbl, htrsw, htrlw, xmu, &
149 & tke_budget, bl_mynn_tkeadvect, &
150 & bl_mynn_cloudpdf, bl_mynn_mixlength, &
151 & bl_mynn_edmf, &
152 & bl_mynn_edmf_mom, bl_mynn_edmf_tke, &
153 & bl_mynn_cloudmix, bl_mynn_mixqt, &
154 & bl_mynn_output, bl_mynn_closure, &
155 & icloud_bl, do_mynnsfclay, &
156 & imp_physics, imp_physics_gfdl, &
157 & imp_physics_thompson, imp_physics_wsm6, &
158 & imp_physics_fa, imfdeepcnv, imfdeepcnv_c3, &
159 & imp_physics_tempo, &
160 & imfdeepcnv_samf, &
161 & chem3d, frp, mix_chem, rrfs_sd, enh_mix, &
162 & nchem, ndvel, vdep, smoke_dbg, &
163 & imp_physics_nssl, nssl_ccn_on, &
164 & ltaerosol, mraerosol, spp_wts_pbl, spp_pbl, &
165 & lprnt, huge, errmsg, errflg )
166
167! should be moved to inside the mynn:
168 use machine, only: kind_phys
169 use bl_mynn_common, only: cp, r_d, grav, g_inv, zero, &
170 xlv, xlvcp, xlscp, p608
171 use module_bl_mynn, only: mynn_bl_driver
172
173!-------------------------------------------------------------------
174 implicit none
175!-------------------------------------------------------------------
176
177 real(kind_phys), intent(in) :: huge
178 character(len=*), intent(out) :: errmsg
179 integer, intent(out) :: errflg
180
181 logical, intent(in) :: lssav, ldiag3d, lsidea, qdiag3d
182 logical, intent(in) :: cplflx
183
184 !smoke/chem
185 integer, intent(in) :: nchem, ndvel
186 integer, parameter :: kdvel=1
187 logical, intent(in) :: smoke_dbg
188
189! NAMELIST OPTIONS (INPUT):
190 logical, intent(in) :: &
191 & bl_mynn_tkeadvect, &
192 & ltaerosol, &
193 & mraerosol, &
194 & lprnt, &
195 & do_mynnsfclay, &
196 & flag_for_pbl_generic_tend, &
197 & nssl_ccn_on
198 integer, intent(in) :: &
199 & bl_mynn_cloudpdf, &
200 & bl_mynn_mixlength, &
201 & icloud_bl, &
202 & bl_mynn_edmf, &
203 & bl_mynn_edmf_mom, &
204 & bl_mynn_edmf_tke, &
205 & bl_mynn_cloudmix, &
206 & bl_mynn_mixqt, &
207 & bl_mynn_output, &
208 & imp_physics, imp_physics_wsm6, &
209 & imp_physics_thompson, imp_physics_gfdl, &
210 & imp_physics_tempo, &
211 & imp_physics_nssl, imp_physics_fa, imfdeepcnv, &
212 & imfdeepcnv_c3, imfdeepcnv_samf, &
213 & spp_pbl, &
214 & tke_budget
215 real(kind_phys), intent(in) :: &
216 & bl_mynn_closure
217
218!TENDENCY DIAGNOSTICS
219 real(kind_phys), intent(inout), optional :: dtend(:,:,:)
220 integer, intent(in) :: dtidx(:,:)
221 integer, intent(in) :: index_of_temperature, index_of_x_wind
222 integer, intent(in) :: index_of_y_wind, index_of_process_pbl
223 integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntsw, ntlnc
224 integer, intent(in) :: ntinc, ntwa, ntia, ntke
225
226!MISC CONFIGURATION OPTIONS
227 INTEGER, PARAMETER :: &
228 & bl_mynn_mixscalars=1
229 LOGICAL :: &
230 & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QS, FLAG_QNC, &
231 & FLAG_QNWFA, FLAG_QNIFA, FLAG_QNBCA, FLAG_OZONE
232 ! Define locally until needed from CCPP
233 LOGICAL, PARAMETER :: cycling = .false.
234
235!MYNN-1D
236 REAL(kind_phys), intent(in) :: delt, dtf
237 INTEGER, intent(in) :: im, levs
238 LOGICAL, intent(in) :: flag_init, flag_restart
239 INTEGER :: initflag, k, i
240 INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, &
241 & IMS,IME,JMS,JME,KMS,KME, &
242 & ITS,ITE,JTS,JTE,KTS,KTE
243
244 REAL(kind_phys) :: tem
245
246!MYNN-3D
247 real(kind_phys), dimension(:,:), intent(in) :: phii
248 real(kind_phys), dimension(:,:), intent(out) :: &
249 & dtdt, dudt, dvdt, dqdt_water_vapor, dqdt_liquid_cloud, &
250 & dqdt_ice, dqdt_snow, dqdt_ozone
251 real(kind_phys), dimension(:,:,:), intent(out) :: dqdt_all
252 real(kind_phys), dimension(:,:), intent(out), optional :: &
253 & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, &
254 & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, dqdt_cccn
255 real(kind_phys), dimension(:,:), intent(inout) :: qke, &
256 & EL_PBL, Sh3D, Sm3D, qc_bl, qi_bl, cldfra_bl
257 real(kind_phys), dimension(:,:), intent(inout) :: &
258 & qke_adv
259 real(kind_phys), dimension(:,:,:), intent(out) :: tmf
260 !These 10 arrays are only allocated when bl_mynn_output > 0
261 real(kind_phys), dimension(:,:), intent(inout), optional :: &
262 & edmf_a,edmf_w,edmf_qt, &
263 & edmf_thl,edmf_ent,edmf_qc, &
264 & sub_thl,sub_sqv,det_thl,det_sqv
265 real(kind_phys), dimension(:,:), intent(in) :: &
266 & t3d,qgrs_water_vapor, qgrs_liquid_cloud, qgrs_ice, &
267 & qgrs_snow
268 real(kind_phys), dimension(:,:), intent(in) :: &
269 & qgrs_cloud_ice_num_conc, &
270 & u,v,omega, &
271 & exner,prsl,prsi, &
272 & qgrs_ozone
273 real(kind_phys), dimension(:,:), intent(in), optional :: &
274 & qgrs_water_aer_num_conc, &
275 & qgrs_cloud_droplet_num_conc, &
276 & qgrs_ice_aer_num_conc
277 real(kind_phys), dimension(:,:), intent(in), optional :: qgrs_cccn
278 real(kind_phys), dimension(:,:), intent(out) :: &
279 & Tsq, Qsq, Cov, exch_h, exch_m
280 real(kind_phys), dimension(:,:), intent(out), optional :: &
281 & dqke, qWT, qSHEAR, qBUOY, qDISS
282 real(kind_phys), dimension(:), intent(in) :: xmu
283 real(kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw
284 ! spp_wts_pbl only allocated if spp_pbl == 1
285 real(kind_phys), dimension(:,:), intent(in), optional :: spp_wts_pbl
286
287 !LOCAL
288 real(kind_phys), dimension(im,levs) :: &
289 & sqv,sqc,sqi,sqs,qnc,qni,ozone,qnwfa,qnifa,qnbca, &
290 & dz, w, p, rho, th, qv, delp, &
291 & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, &
292 & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, RQSBLTEN, &
293 & RQNWFABLTEN, RQNIFABLTEN, RQNBCABLTEN, adj_t
294
295!smoke/chem arrays
296 real(kind_phys), dimension(:), intent(inout), optional :: frp
297 logical, intent(in) :: mix_chem, enh_mix, rrfs_sd
298 real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d
299 real(kind_phys), dimension(:,: ), intent(in), optional :: vdep
300 real(kind_phys), dimension(im) :: emis_ant_no
301
302!MYNN-2D
303 real(kind_phys), dimension(:), intent(in) :: &
304 & dx,zorl,slmsk,tsurf,qsfc,ps, &
305 & hflx,qflx,ust,wspd,rb,recmol
306
307 real(kind_phys), dimension(:), intent(in), optional :: &
308 & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice
309 real(kind_phys), dimension(:), intent(in) :: &
310 & stress_wat,hflx_wat,qflx_wat, &
311 & oceanfrac,fice
312
313 logical, dimension(:), intent(in) :: &
314 & wet, dry, icy
315
316 real(kind_phys), dimension(:), intent(inout) :: &
317 & pblh,dusfc_diag,dvsfc_diag,dtsfc_diag,dqsfc_diag
318 real(kind_phys), dimension(:), intent(out) :: &
319 & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, &
320 & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag
321 real(kind_phys), dimension(:), intent(out) :: &
322 & maxMF,maxwidth,ztop_plume
323 integer, dimension(:), intent(inout) :: &
324 & kpbl
325 integer, dimension(:), intent(inout) :: &
326 & ktop_plume
327
328 real(kind_phys), dimension(:), intent(inout), optional :: &
329 & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl
330 real(kind_phys), dimension(:), intent(inout), optional :: &
331 & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl
332
333 !LOCAL
334 real(kind_phys), dimension(im) :: &
335 & hfx,qfx,rmol,xland,uoce,voce,znt,ts
336 integer :: idtend
337 real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1
338 real(kind_phys), allocatable :: save_qke_adv(:,:)
339 real(kind_phys), dimension(levs) :: kzero
340
341 ! Initialize CCPP error handling variables
342 errmsg = ''
343 errflg = 0
344
345 dtdt = 0.0
346 dudt = 0.0
347 dvdt = 0.0
348 dqdt_all = 0.0
349 dqdt_water_vapor = 0.0
350 dqdt_liquid_cloud = 0.0
351 dqdt_ice = 0.0
352 dqdt_snow = 0.0
353 dqdt_ozone = 0.0
354 if (imp_physics == imp_physics_thompson) then
355 if (ltaerosol .or. mraerosol) then
356 if (ltaerosol) then
357 dqdt_water_aer_num_conc = 0.0
358 dqdt_ice_aer_num_conc = 0.0
359 end if
360 dqdt_cloud_droplet_num_conc = 0.0
361 end if
362 dqdt_ice_num_conc = 0.0
363 end if
364 if (imp_physics == imp_physics_nssl) then
365 dqdt_cloud_droplet_num_conc = 0.0
366 dqdt_ice_num_conc = 0.0
367 if (nssl_ccn_on) dqdt_cccn = 0.0
368 end if
369 adj_t = t3d
370
371
372 if (lprnt) then
373 write(0,*)"=============================================="
374 write(0,*)"in mynn wrapper..."
375 write(0,*)"flag_init=",flag_init
376 write(0,*)"flag_restart=",flag_restart
377 endif
378
379 if (.not. flag_for_pbl_generic_tend .and. ldiag3d) then
380 idtend = dtidx(ntke+100,index_of_process_pbl)
381 if (idtend>=1) then
382 allocate(save_qke_adv(im,levs))
383 save_qke_adv=qke_adv
384 endif
385 endif
386
387 ! DH* TODO: Use flag_restart to distinguish which fields need
388 ! to be initialized and which are read from restart files
389 if (flag_init) then
390 initflag=1
391 !print*,"in MYNN, initflag=",initflag
392 else
393 initflag=0
394 !print*,"in MYNN, initflag=",initflag
395 endif
396
397 kzero = zero !generic zero array
398 !initialize arrays for test
399 emis_ant_no = 0.
400
401 flag_ozone = ntoz>0
402
403 ! Assign variables for each microphysics scheme
404 if (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fa) then
405 ! WSM6 or Ferrier-Aligo
406 flag_qi = .true.
407 flag_qni= .false.
408 flag_qc = .true.
409 flag_qnc= .false.
410 flag_qs = .false.
411 flag_qnwfa= .false.
412 flag_qnifa= .false.
413 flag_qnbca= .false.
414 do k=1,levs
415 do i=1,im
416 sqv(i,k) = qgrs_water_vapor(i,k)
417 sqc(i,k) = qgrs_liquid_cloud(i,k)
418 sqi(i,k) = qgrs_ice(i,k)
419 sqs(i,k) = 0.
420 ozone(i,k) = qgrs_ozone(i,k)
421 qnc(i,k) = 0.
422 qni(i,k) = 0.
423 qnwfa(i,k) = 0.
424 qnifa(i,k) = 0.
425 qnbca(i,k) = 0.
426 enddo
427 enddo
428 elseif (imp_physics == imp_physics_nssl ) then
429 ! NSSL
430 flag_qi = .true.
431 flag_qni= .true.
432 flag_qc = .true.
433 flag_qnc= .true.
434 flag_qs = .true.
435 flag_qnwfa= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field?
436 flag_qnifa= .false.
437 flag_qnbca= .false.
438 do k=1,levs
439 do i=1,im
440 sqv(i,k) = qgrs_water_vapor(i,k)
441 sqc(i,k) = qgrs_liquid_cloud(i,k)
442 sqi(i,k) = qgrs_ice(i,k)
443 sqs(i,k) = qgrs_snow(i,k)
444 ozone(i,k) = qgrs_ozone(i,k)
445 qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
446 qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
447 qnwfa(i,k) = 0.
448 IF ( nssl_ccn_on ) THEN
449 qnwfa(i,k) = qgrs_cccn(i,k)
450 ENDIF
451 qnifa(i,k) = 0.
452 qnbca(i,k) = 0.
453 enddo
454 enddo
455 elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then
456 ! Thompson
457 if(ltaerosol) then
458 flag_qi = .true.
459 flag_qni= .true.
460 flag_qc = .true.
461 flag_qs = .true. !pipe it in, but do not mix
462 flag_qnc= .true.
463 flag_qnwfa= .true.
464 flag_qnifa= .true.
465 flag_qnbca= .false.
466 do k=1,levs
467 do i=1,im
468 sqv(i,k) = qgrs_water_vapor(i,k)
469 sqc(i,k) = qgrs_liquid_cloud(i,k)
470 sqi(i,k) = qgrs_ice(i,k)
471 sqs(i,k) = qgrs_snow(i,k)
472 qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
473 qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
474 ozone(i,k) = qgrs_ozone(i,k)
475 qnwfa(i,k) = qgrs_water_aer_num_conc(i,k)
476 qnifa(i,k) = qgrs_ice_aer_num_conc(i,k)
477 qnbca(i,k) = 0.
478 enddo
479 enddo
480 else if(mraerosol .and. imp_physics == imp_physics_thompson) then
481 flag_qi = .true.
482 flag_qni= .true.
483 flag_qc = .true.
484 flag_qs = .true.
485 flag_qnc= .true.
486 flag_qnwfa= .false.
487 flag_qnifa= .false.
488 flag_qnbca= .false.
489 do k=1,levs
490 do i=1,im
491 sqv(i,k) = qgrs_water_vapor(i,k)
492 sqc(i,k) = qgrs_liquid_cloud(i,k)
493 sqi(i,k) = qgrs_ice(i,k)
494 sqs(i,k) = qgrs_snow(i,k)
495 qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k)
496 qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
497 ozone(i,k) = qgrs_ozone(i,k)
498 qnwfa(i,k) = 0.
499 qnifa(i,k) = 0.
500 qnbca(i,k) = 0.
501 enddo
502 enddo
503 else
504 flag_qi = .true.
505 flag_qni= .true.
506 flag_qc = .true.
507 flag_qs = .true.
508 flag_qnc= .false.
509 flag_qnwfa= .false.
510 flag_qnifa= .false.
511 flag_qnbca= .false.
512 do k=1,levs
513 do i=1,im
514 sqv(i,k) = qgrs_water_vapor(i,k)
515 sqc(i,k) = qgrs_liquid_cloud(i,k)
516 sqi(i,k) = qgrs_ice(i,k)
517 sqs(i,k) = qgrs_snow(i,k)
518 qnc(i,k) = 0.
519 qni(i,k) = qgrs_cloud_ice_num_conc(i,k)
520 ozone(i,k) = qgrs_ozone(i,k)
521 qnwfa(i,k) = 0.
522 qnifa(i,k) = 0.
523 qnbca(i,k) = 0.
524 enddo
525 enddo
526 endif
527 elseif (imp_physics == imp_physics_gfdl) then
528 ! GFDL MP
529 flag_qi = .true.
530 flag_qni= .false.
531 flag_qc = .true.
532 flag_qnc= .false.
533 flag_qs = .false.
534 flag_qnwfa= .false.
535 flag_qnifa= .false.
536 flag_qnbca= .false.
537 do k=1,levs
538 do i=1,im
539 sqv(i,k) = qgrs_water_vapor(i,k)
540 sqc(i,k) = qgrs_liquid_cloud(i,k)
541 sqi(i,k) = qgrs_ice(i,k)
542 qnc(i,k) = 0.
543 qni(i,k) = 0.
544 sqs(i,k) = 0.
545 qnwfa(i,k) = 0.
546 qnifa(i,k) = 0.
547 qnbca(i,k) = 0.
548 ozone(i,k) = qgrs_ozone(i,k)
549 enddo
550 enddo
551 else
552 print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics
553 print*,"Defaulting to qc and qv species only..."
554 flag_qi = .false.
555 flag_qni= .false.
556 flag_qc = .true.
557 flag_qnc= .false.
558 flag_qs = .false.
559 flag_qnwfa= .false.
560 flag_qnifa= .false.
561 flag_qnbca= .false.
562 do k=1,levs
563 do i=1,im
564 sqv(i,k) = qgrs_water_vapor(i,k)
565 sqc(i,k) = qgrs_liquid_cloud(i,k)
566 sqi(i,k) = 0.
567 sqs(i,k) = 0.
568 qnc(i,k) = 0.
569 qni(i,k) = 0.
570 qnwfa(i,k) = 0.
571 qnifa(i,k) = 0.
572 qnbca(i,k) = 0.
573 ozone(i,k) = qgrs_ozone(i,k)
574 enddo
575 enddo
576 endif
577
578 do k=1,levs
579 do i=1,im
580 tmf(i,k,1)=0.
581 enddo
582 enddo
583
584
585 ! Check incoming moist species to ensure non-negative values
586 ! First, create height difference (dz)
587 do k=1,levs
588 do i=1,im
589 dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv
590 enddo
591 enddo
592
593 do i=1,im
594 do k=1,levs
595 delp(i,k) = prsi(i,k) - prsi(i,k+1)
596 enddo
597 enddo
598
599 do i=1,im
600 call moisture_check2(levs, delt, &
601 delp(i,:), exner(i,:), &
602 sqv(i,:), sqc(i,:), &
603 sqi(i,:), kzero(:), &
604 adj_t(i,:) )
605 enddo
606
607 do k=1,levs
608 do i=1,im
609 th(i,k)=adj_t(i,k)/exner(i,k)
610 rho(i,k)=prsl(i,k)/(r_d*adj_t(i,k)*(1.+p608*max(sqv(i,k),1e-8)))
611 w(i,k) = -omega(i,k)/(rho(i,k)*grav)
612 enddo
613 enddo
614
615 !intialize more variables
616 do i=1,im
617 if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3
618 xland(i)=1.0 !but land/water = (1/2) in SFCLAY_mynn
619 else
620 xland(i)=2.0
621 endif
622 uoce(i)=0.0
623 voce(i)=0.0
624 !ust(i) = sqrt(stress(i))
625 ch(i)=0.0
626 hfx(i)=hflx(i)*rho(i,1)*cp
627 qfx(i)=qflx(i)*rho(i,1)
628 !filter bad incoming fluxes
629 if (hfx(i) > 1200.)hfx(i) = 1200.
630 if (hfx(i) < -500.)hfx(i) = -500.
631 if (qfx(i) > .0005)qfx(i) = 0.0005
632 if (qfx(i) < -.0002)qfx(i) = -0.0002
633
634 dtsfc1(i) = hfx(i)
635 dqsfc1(i) = qfx(i)*xlv
636 dusfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*u(i,1)/wspd(i)
637 dvsfc1(i) = -1.*rho(i,1)*ust(i)*ust(i)*v(i,1)/wspd(i)
638
639 !BWG: diagnostic surface fluxes for scalars & momentum
640 dtsfci_diag(i) = dtsfc1(i)
641 dqsfci_diag(i) = dqsfc1(i)
642 dtsfc_diag(i) = dtsfc_diag(i) + dtsfc1(i)*delt
643 dqsfc_diag(i) = dqsfc_diag(i) + dqsfc1(i)*delt
644 dusfci_diag(i) = dusfc1(i)
645 dvsfci_diag(i) = dvsfc1(i)
646 dusfc_diag(i) = dusfc_diag(i) + dusfci_diag(i)*delt
647 dvsfc_diag(i) = dvsfc_diag(i) + dvsfci_diag(i)*delt
648
649 znt(i)=zorl(i)*0.01 !cm -> m?
650 if (do_mynnsfclay) then
651 rmol(i)=recmol(i)
652 else
653 if (hfx(i) .ge. 0.)then
654 rmol(i)=-hfx(i)/(200.*dz(i,1)*0.5)
655 else
656 rmol(i)=abs(rb(i))*1./(dz(i,1)*0.5)
657 endif
658 endif
659 ts(i)=tsurf(i)/exner(i,1) !theta
660! qsfc(i)=qss(i)
661! ps(i)=pgr(i)
662! wspd(i)=wind(i)
663 enddo
664
665 ! BWG: Coupling insertion
666 if (cplflx) then
667 do i=1,im
668 if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES
669 if ( .not. wet(i)) then ! no open water, use results from CICE
670 dusfci_cpl(i) = dusfc_cice(i)
671 dvsfci_cpl(i) = dvsfc_cice(i)
672 dtsfci_cpl(i) = dtsfc_cice(i)
673 dqsfci_cpl(i) = dqsfc_cice(i)
674 elseif (icy(i) .or. dry(i)) then ! use stress_ocean for opw component at mixed point
675 if (wspd(i) > zero) then
676 dusfci_cpl(i) = -1.*rho(i,1)*stress_wat(i)*u(i,1)/wspd(i) ! U-momentum flux
677 dvsfci_cpl(i) = -1.*rho(i,1)*stress_wat(i)*v(i,1)/wspd(i) ! V-momentum flux
678 else
679 dusfci_cpl(i) = zero
680 dvsfci_cpl(i) = zero
681 endif
682 dtsfci_cpl(i) = cp*rho(i,1)*hflx_wat(i) ! sensible heat flux over open ocean
683 dqsfci_cpl(i) = xlv*rho(i,1)*qflx_wat(i) ! latent heat flux over open ocean
684 else ! use results from this scheme for 100% open ocean
685 dusfci_cpl(i) = dusfci_diag(i)
686 dvsfci_cpl(i) = dvsfci_diag(i)
687 dtsfci_cpl(i) = dtsfci_diag(i)
688 dqsfci_cpl(i) = dqsfci_diag(i)
689 endif
690!
691 dusfc_cpl(i) = dusfc_cpl(i) + dusfci_cpl(i) * delt
692 dvsfc_cpl(i) = dvsfc_cpl(i) + dvsfci_cpl(i) * delt
693 dtsfc_cpl(i) = dtsfc_cpl(i) + dtsfci_cpl(i) * delt
694 dqsfc_cpl(i) = dqsfc_cpl(i) + dqsfci_cpl(i) * delt
695 else ! If no ocean
696 dusfc_cpl(i) = huge
697 dvsfc_cpl(i) = huge
698 dtsfc_cpl(i) = huge
699 dqsfc_cpl(i) = huge
700 endif ! Ocean only, NO LAKES
701 enddo
702 endif ! End coupling insertion
703
704 if (lprnt) then
705 print*
706 write(0,*)"===CALLING mynn_bl_driver; input:"
707 print*,"tke_budget=",tke_budget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect
708 print*,"bl_mynn_cloudpdf=",bl_mynn_cloudpdf," bl_mynn_mixlength=",bl_mynn_mixlength
709 print*,"bl_mynn_edmf=",bl_mynn_edmf," bl_mynn_edmf_mom=",bl_mynn_edmf_mom
710 print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke
711 print*,"bl_mynn_cloudmix=",bl_mynn_cloudmix," bl_mynn_mixqt=",bl_mynn_mixqt
712 print*,"icloud_bl=",icloud_bl
713 print*,"T:",adj_t(1,1),adj_t(1,2),adj_t(1,levs)
714 print*,"TH:",th(1,1),th(1,2),th(1,levs)
715 print*,"rho:",rho(1,1),rho(1,2),rho(1,levs)
716 print*,"exner:",exner(1,1),exner(1,2),exner(1,levs)
717 print*,"prsl:",prsl(1,1),prsl(1,2),prsl(1,levs)
718 print*,"dz:",dz(1,1),dz(1,2),dz(1,levs)
719 print*,"u:",u(1,1),u(1,2),u(1,levs)
720 print*,"v:",v(1,1),v(1,2),v(1,levs)
721 print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs)
722 print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs)
723 print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs)
724 print*,"rmol:",rmol(1)," ust:",ust(1)
725 print*," dx=",dx(1),"initflag=",initflag
726 print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1)
727 print*,"HFX:",hfx(1)," qfx",qfx(1)
728 print*,"qsfc:",qsfc(1)," ps:",ps(1)
729 print*,"wspd:",wspd(1)," rb=",rb(1)
730 print*,"znt:",znt(1)," delt=",delt
731 print*,"im=",im," levs=",levs
732 print*,"PBLH=",pblh(1)," KPBL=",kpbl(1)," xland=",xland(1)
733 print*,"ch=",ch(1)
734 !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs)
735 print*,"qke:",qke(1,1),qke(1,2),qke(1,levs)
736 print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs)
737 print*,"Sh3d:",sh3d(1,1),sh3d(1,2),sh3d(1,levs)
738 !print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs) ! - intent(out)
739 !print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs) ! - intent(out)
740 print*,"max cf_bl:",maxval(cldfra_bl(1,:))
741 endif
742
743
744 CALL mynn_bl_driver( &
745 & initflag=initflag,restart=flag_restart, &
746 & cycling=cycling, &
747 & delt=delt,dz=dz,dx=dx,znt=znt, &
748 & u=u,v=v,w=w,th=th,sqv3d=sqv,sqc3d=sqc, &
749 & sqi3d=sqi,sqs3d=sqs,qnc=qnc,qni=qni, &
750 & qnwfa=qnwfa,qnifa=qnifa,qnbca=qnbca,ozone=ozone, &
751 & p=prsl,exner=exner,rho=rho,t3d=adj_t, &
752 & xland=xland,ts=ts,qsfc=qsfc,ps=ps, &
753 & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, &
754 & wspd=wspd,uoce=uoce,voce=voce, & !input
755 & qke=qke,qke_adv=qke_adv, & !output !GJF qke_adv needs to be intent(in)
756 & sh3d=sh3d,sm3d=sm3d, &
757!chem/smoke
758 & nchem=nchem,kdvel=kdvel,ndvel=ndvel, &
759 & chem3d=chem3d,vdep=vdep,smoke_dbg=smoke_dbg, &
760 & frp=frp,emis_ant_no=emis_ant_no, &
761 & mix_chem=mix_chem,enh_mix=enh_mix, &
762 & rrfs_sd=rrfs_sd, &
763!-----
764 & tsq=tsq,qsq=qsq,cov=cov, & !output
765 & rublten=rublten,rvblten=rvblten,rthblten=rthblten, & !output
766 & rqvblten=rqvblten,rqcblten=rqcblten, &
767 & rqiblten=rqiblten,rqncblten=rqncblten, & !output
768 & rqsblten=rqsblten, & !output
769 & rqniblten=rqniblten,rqnwfablten=rqnwfablten, & !output
770 & rqnifablten=rqnifablten,rqnbcablten=rqnbcablten, & !output
771 & dozone=dqdt_ozone, & !output
772 & exch_h=exch_h,exch_m=exch_m, & !output
773 & pblh=pblh,kpbl=kpbl, & !output
774 & el_pbl=el_pbl, & !output
775 & dqke=dqke, & !output
776 & qwt=qwt,qshear=qshear,qbuoy=qbuoy,qdiss=qdiss, & !output
777 & bl_mynn_tkeadvect=bl_mynn_tkeadvect, &
778 & tke_budget=tke_budget, & !input parameter
779 & bl_mynn_cloudpdf=bl_mynn_cloudpdf, & !input parameter
780 & bl_mynn_mixlength=bl_mynn_mixlength, & !input parameter
781 & icloud_bl=icloud_bl, & !input parameter
782 & qc_bl=qc_bl,qi_bl=qi_bl,cldfra_bl=cldfra_bl, & !output
783 & closure=bl_mynn_closure,bl_mynn_edmf=bl_mynn_edmf, & !input parameter
784 & bl_mynn_edmf_mom=bl_mynn_edmf_mom, & !input parameter
785 & bl_mynn_edmf_tke=bl_mynn_edmf_tke, & !input parameter
786 & bl_mynn_mixscalars=bl_mynn_mixscalars, & !input parameter
787 & bl_mynn_output=bl_mynn_output, & !input parameter
788 & bl_mynn_cloudmix=bl_mynn_cloudmix, & !input parameter
789 & bl_mynn_mixqt=bl_mynn_mixqt, & !input parameter
790 & edmf_a=edmf_a,edmf_w=edmf_w,edmf_qt=edmf_qt, & !output
791 & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,& !output
792 & sub_thl3d=sub_thl,sub_sqv3d=sub_sqv, &
793 & det_thl3d=det_thl,det_sqv3d=det_sqv, &
794 & maxwidth=maxwidth,maxmf=maxmf,ztop_plume=ztop_plume,& !output
795 & ktop_plume=ktop_plume, & !output
796 & spp_pbl=spp_pbl,pattern_spp_pbl=spp_wts_pbl, & !input
797 & rthraten=htrlw, & !input
798 & flag_qi=flag_qi,flag_qni=flag_qni, & !input
799 & flag_qc=flag_qc,flag_qnc=flag_qnc,flag_qs=flag_qs, & !input
800 & flag_qnwfa=flag_qnwfa,flag_qnifa=flag_qnifa, & !input
801 & flag_qnbca=flag_qnbca,flag_ozone=flag_ozone, & !input
802 & ids=1,ide=im,jds=1,jde=1,kds=1,kde=levs, & !input
803 & ims=1,ime=im,jms=1,jme=1,kms=1,kme=levs, & !input
804 & its=1,ite=im,jts=1,jte=1,kts=1,kte=levs ) !input
805
806
807 ! POST MYNN (INTERSTITIAL) WORK:
808 !update/save MYNN-only variables
809 !do k=1,levs
810 ! do i=1,im
811 ! gq0(i,k,4)=qke(i,k,1) !tke*2
812 ! enddo
813 !enddo
814 !For MYNN, convert TH-tend to T-tend
815 do k = 1, levs
816 do i = 1, im
817 dtdt(i,k) = rthblten(i,k)*exner(i,k)
818 dudt(i,k) = rublten(i,k)
819 dvdt(i,k) = rvblten(i,k)
820 enddo
821 enddo
822 accum_duvt3dt: if(ldiag3d .or. lsidea) then
823 call dtend_helper(index_of_x_wind,dudt)
824 call dtend_helper(index_of_y_wind,dvdt)
825 call dtend_helper(index_of_temperature,dtdt)
826 if(ldiag3d) then
827 call dtend_helper(100+ntoz,dqdt_ozone)
828 endif
829 endif accum_duvt3dt
830 !Update T, U and V:
831 !do k = 1, levs
832 ! do i = 1, im
833 ! T3D(i,k) = adj_t(i,k) + RTHBLTEN(i,k)*exner(i,k)*delt
834 ! u(i,k) = u(i,k) + RUBLTEN(i,k)*delt
835 ! v(i,k) = v(i,k) + RVBLTEN(i,k)*delt
836 ! enddo
837 !enddo
838
839 !DO moist/scalar/tracer tendencies:
840 if (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fa) then
841 ! WSM6
842 do k=1,levs
843 do i=1,im
844 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
845 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
846 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
847 dqdt_snow(i,k) = rqsblten(i,k) !/(1.0 + qv(i,k))
848 !dqdt_ozone(i,k) = 0.0
849 enddo
850 enddo
851 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
852 call dtend_helper(100+ntqv,rqvblten)
853 call dtend_helper(100+ntcw,rqcblten)
854 call dtend_helper(100+ntiw,rqiblten)
855 endif
856 !Update moist species:
857 !do k=1,levs
858 ! do i=1,im
859 ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt
860 ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt
861 ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt
862 ! !dqdt_ozone(i,k) = 0.0
863 ! enddo
864 !enddo
865 elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then
866 ! Thompson-Aerosol
867 if(ltaerosol) then
868 do k=1,levs
869 do i=1,im
870 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
871 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
872 dqdt_cloud_droplet_num_conc(i,k) = rqncblten(i,k)
873 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
874 dqdt_ice_num_conc(i,k) = rqniblten(i,k)
875 dqdt_snow(i,k) = rqsblten(i,k) !/(1.0 + qv(i,k))
876 !dqdt_ozone(i,k) = 0.0
877 dqdt_water_aer_num_conc(i,k) = rqnwfablten(i,k)
878 dqdt_ice_aer_num_conc(i,k) = rqnifablten(i,k)
879 enddo
880 enddo
881 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
882 call dtend_helper(100+ntqv,rqvblten)
883 call dtend_helper(100+ntcw,rqcblten)
884 call dtend_helper(100+ntlnc,rqncblten)
885 call dtend_helper(100+ntiw,rqiblten)
886 call dtend_helper(100+ntinc,rqniblten)
887 call dtend_helper(100+ntwa,rqnwfablten)
888 call dtend_helper(100+ntia,rqnifablten)
889 endif
890 !do k=1,levs
891 ! do i=1,im
892 ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt
893 ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt
894 ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt
895 ! qgrs_cloud_droplet_num_conc(i,k) = qgrs_cloud_droplet_num_conc(i,k) + RQNCBLTEN(i,k)*delt
896 ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt
897 ! !dqdt_ozone(i,k) = 0.0
898 ! !qgrs_water_aer_num_conc(i,k) = qgrs_water_aer_num_conc(i,k) + RQNWFABLTEN(i,k)*delt
899 ! !qgrs_ice_aer_num_conc(i,k) = qgrs_ice_aer_num_conc(i,k) + RQNIFABLTEN(i,k)*delt
900 ! enddo
901 !enddo
902 else if(mraerosol .and. imp_physics == imp_physics_thompson) then
903 do k=1,levs
904 do i=1,im
905 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
906 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
907 dqdt_cloud_droplet_num_conc(i,k) = rqncblten(i,k)
908 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
909 dqdt_ice_num_conc(i,k) = rqniblten(i,k)
910 dqdt_snow(i,k) = rqsblten(i,k) !/(1.0 + qv(i,k))
911 enddo
912 enddo
913 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
914 call dtend_helper(100+ntqv,rqvblten)
915 call dtend_helper(100+ntcw,rqcblten)
916 call dtend_helper(100+ntlnc,rqncblten)
917 call dtend_helper(100+ntiw,rqiblten)
918 call dtend_helper(100+ntinc,rqniblten)
919 endif
920 else
921 !Thompson (2008)
922 do k=1,levs
923 do i=1,im
924 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
925 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
926 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
927 dqdt_ice_num_conc(i,k) = rqniblten(i,k)
928 dqdt_snow(i,k) = rqsblten(i,k) !/(1.0 + qv(i,k))
929 !dqdt_ozone(i,k) = 0.0
930 enddo
931 enddo
932 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
933 call dtend_helper(100+ntqv,rqvblten)
934 call dtend_helper(100+ntcw,rqcblten)
935 call dtend_helper(100+ntiw,rqiblten)
936 call dtend_helper(100+ntinc,rqniblten)
937 !call dtend_helper(100+ntsw,RQSBLTEN)
938 endif
939 !do k=1,levs
940 ! do i=1,im
941 ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt
942 ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt
943 ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt
944 ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt
945 ! !dqdt_ozone(i,k) = 0.0
946 ! enddo
947 !enddo
948 endif !end thompson choice
949 elseif (imp_physics == imp_physics_nssl) then
950 ! NSSL
951 do k=1,levs
952 do i=1,im
953 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
954 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
955 dqdt_cloud_droplet_num_conc(i,k) = rqncblten(i,k)
956 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
957 dqdt_ice_num_conc(i,k) = rqniblten(i,k)
958 dqdt_snow(i,k) = rqsblten(i,k) !/(1.0 + qv(i,k))
959 IF ( nssl_ccn_on ) THEN !
960 dqdt_cccn(i,k) = rqnwfablten(i,k)
961 ENDIF
962 enddo
963 enddo
964
965 elseif (imp_physics == imp_physics_gfdl) then
966 ! GFDL MP
967 do k=1,levs
968 do i=1,im
969 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
970 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
971 dqdt_ice(i,k) = rqiblten(i,k) !/(1.0 + qv(i,k))
972 !dqdt_rain(i,k) = 0.0
973 !dqdt_snow(i,k) = 0.0
974 !dqdt_graupel(i,k) = 0.0
975 !dqdt_ozone(i,k) = 0.0
976 enddo
977 enddo
978 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
979 call dtend_helper(100+ntqv,rqvblten)
980 call dtend_helper(100+ntcw,rqcblten)
981 call dtend_helper(100+ntiw,rqiblten)
982 endif
983 !do k=1,levs
984 ! do i=1,im
985 ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt
986 ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt
987 ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt
988 ! !dqdt_ozone(i,k) = 0.0
989 ! enddo
990 !enddo
991 else
992! print*,"In MYNN wrapper. Unknown microphysics scheme, imp_physics=",imp_physics
993 do k=1,levs
994 do i=1,im
995 dqdt_water_vapor(i,k) = rqvblten(i,k) !/(1.0 + qv(i,k))
996 dqdt_liquid_cloud(i,k) = rqcblten(i,k) !/(1.0 + qv(i,k))
997 dqdt_ice(i,k) = 0.0
998 !dqdt_rain(i,k) = 0.0
999 !dqdt_snow(i,k) = 0.0
1000 !dqdt_graupel(i,k) = 0.0
1001 !dqdt_ozone(i,k) = 0.0
1002 enddo
1003 enddo
1004 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
1005 call dtend_helper(100+ntqv,rqvblten)
1006 call dtend_helper(100+ntcw,rqcblten)
1007 call dtend_helper(100+ntiw,rqiblten)
1008 endif
1009 endif
1010
1011 if (lprnt) then
1012 print*
1013 print*,"===Finished with mynn_bl_driver; output:"
1014 print*,"T:",adj_t(1,1),adj_t(1,2),adj_t(1,levs)
1015 print*,"TH:",th(1,1),th(1,2),th(1,levs)
1016 print*,"rho:",rho(1,1),rho(1,2),rho(1,levs)
1017 print*,"exner:",exner(1,1),exner(1,2),exner(1,levs)
1018 print*,"prsl:",prsl(1,1),prsl(1,2),prsl(1,levs)
1019 print*,"dz:",dz(1,1),dz(1,2),dz(1,levs)
1020 print*,"u:",u(1,1),u(1,2),u(1,levs)
1021 print*,"v:",v(1,1),v(1,2),v(1,levs)
1022 print*,"sqv:",sqv(1,1),sqv(1,2),sqv(1,levs)
1023 print*,"sqc:",sqc(1,1),sqc(1,2),sqc(1,levs)
1024 print*,"sqi:",sqi(1,1),sqi(1,2),sqi(1,levs)
1025 print*,"rmol:",rmol(1)," ust:",ust(1)
1026 print*,"dx(1)=",dx(1),"initflag=",initflag
1027 print*,"Tsurf:",tsurf(1)," Thetasurf:",ts(1)
1028 print*,"HFX:",hfx(1)," qfx",qfx(1)
1029 print*,"qsfc:",qsfc(1)," ps:",ps(1)
1030 print*,"wspd:",wspd(1)," rb=",rb(1)
1031 print*,"znt:",znt(1)," delt=",delt
1032 print*,"im=",im," levs=",levs
1033 print*,"PBLH=",pblh(1)," KPBL=",kpbl(1)," xland=",xland(1)
1034 print*,"ch=",ch(1)
1035 print*,"qke:",qke(1,1),qke(1,2),qke(1,levs)
1036 print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs)
1037 print*,"Sh3d:",sh3d(1,1),sh3d(1,2),sh3d(1,levs)
1038 print*,"exch_h:",exch_h(1,1),exch_h(1,2),exch_h(1,levs)
1039 print*,"exch_m:",exch_m(1,1),exch_m(1,2),exch_m(1,levs)
1040 print*,"max cf_bl:",maxval(cldfra_bl(1,:))
1041 print*,"max qc_bl:",maxval(qc_bl(1,:))
1042 print*,"dtdt:",dtdt(1,1),dtdt(1,2),dtdt(1,levs)
1043 print*,"dudt:",dudt(1,1),dudt(1,2),dudt(1,levs)
1044 print*,"dvdt:",dvdt(1,1),dvdt(1,2),dvdt(1,levs)
1045 print*,"dqdt:",dqdt_water_vapor(1,1),dqdt_water_vapor(1,2),dqdt_water_vapor(1,levs)
1046 print*,"ztop_plume:",ztop_plume(1)," maxmf:",maxmf(1)
1047 print*,"maxwidth:",maxwidth(1)
1048 print*
1049 endif
1050
1051 if(allocated(save_qke_adv)) then
1052 if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then
1053 idtend = dtidx(100+ntke,index_of_process_pbl)
1054 if(idtend>=1) then
1055 dtend(:,:,idtend) = dtend(:,:,idtend) + qke_adv-save_qke_adv
1056 endif
1057 endif
1058 deallocate(save_qke_adv)
1059 endif
1060
1061 if(imfdeepcnv == imfdeepcnv_c3 .or. imfdeepcnv == imfdeepcnv_samf)then
1062 !LB: save PBL q-tendency for use in prognostic closure
1063 do k=1,levs
1064 do i=1,im
1065 tmf(i,k,1)=dqdt_water_vapor(i,k)
1066 enddo
1067 enddo
1068 endif
1069
1070 CONTAINS
1071
1072 SUBROUTINE dtend_helper(itracer,field,mult)
1073 real(kind_phys), intent(in) :: field(im,levs)
1074 real(kind_phys), intent(in), optional :: mult(im,levs)
1075 integer, intent(in) :: itracer
1076 integer :: idtend
1077
1078 idtend=dtidx(itracer,index_of_process_pbl)
1079 if(idtend>=1) then
1080 if(present(mult)) then
1081 dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf*mult
1082 else
1083 dtend(:,:,idtend) = dtend(:,:,idtend) + field*dtf
1084 endif
1085 endif
1086 END SUBROUTINE dtend_helper
1087
1088! ==================================================================
1089 SUBROUTINE moisture_check2(kte, delt, dp, exner, &
1090 qv, qc, qi, qs, th )
1091 !
1092 ! If qc < qcmin, qi < qimin, or qv < qvmin happens in any layer,
1093 ! force them to be larger than minimum value by (1) condensating
1094 ! water vapor into liquid or ice, and (2) by transporting water vapor
1095 ! from the very lower layer.
1096 !
1097 ! We then update the final state variables and tendencies associated
1098 ! with this correction. If any condensation happens, update theta/temperature too.
1099 ! Note that (qv,qc,qi,th) are the final state variables after
1100 ! applying corresponding input tendencies and corrective tendencies.
1101
1102 implicit none
1103 integer, intent(in) :: kte
1104 real(kind_phys), intent(in) :: delt
1105 real(kind_phys), dimension(kte), intent(in) :: dp, exner
1106 real(kind_phys), dimension(kte), intent(inout) :: qv, qc, qi, qs, th
1107 integer k
1108 real :: dqc2, dqi2, dqs2, dqv2, sum, aa, dum
1109 real, parameter :: qvmin1= 1e-8, & !min at k=1
1110 qvmin = 1e-20, & !min above k=1
1111 qcmin = 0.0, &
1112 qimin = 0.0
1113
1114 do k = kte, 1, -1 ! From the top to the surface
1115 dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0)
1116 dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0)
1117 dqs2 = max(0.0, qimin-qs(k)) !qs deficit (>=0)
1118
1119 !update species
1120 qc(k) = qc(k) + dqc2
1121 qi(k) = qi(k) + dqi2
1122 qs(k) = qs(k) + dqs2
1123 qv(k) = qv(k) - dqc2 - dqi2 - dqs2
1124 !for theta
1125 !th(k) = th(k) + xlvcp/exner(k)*dqc2 + &
1126 ! xlscp/exner(k)*dqi2
1127 !for temperature
1128 th(k) = th(k) + xlvcp*dqc2 + &
1129 xlscp*(dqi2+dqs2)
1130
1131 !then fix qv if lending qv made it negative
1132 if (k .eq. 1) then
1133 dqv2 = max(0.0, qvmin1-qv(k)) !qv deficit (>=0)
1134 qv(k) = qv(k) + dqv2
1135 qv(k) = max(qv(k),qvmin1)
1136 dqv2 = 0.0
1137 else
1138 dqv2 = max(0.0, qvmin-qv(k)) !qv deficit (>=0)
1139 qv(k) = qv(k) + dqv2
1140 qv(k-1)= qv(k-1) - dqv2*dp(k)/dp(k-1)
1141 qv(k) = max(qv(k),qvmin)
1142 endif
1143 qc(k) = max(qc(k),qcmin)
1144 qi(k) = max(qi(k),qimin)
1145 qs(k) = max(qs(k),qimin)
1146 end do
1147
1148 ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally
1149 ! extracted from all the layers that has 'qv > 2*qvmin'. This fully
1150 ! preserves column moisture.
1151 if( dqv2 .gt. 1.e-20 ) then
1152 sum = 0.0
1153 do k = 1, kte
1154 if( qv(k) .gt. 2.0*qvmin ) sum = sum + qv(k)*dp(k)
1155 enddo
1156 aa = dqv2*dp(1)/max(1.e-20,sum)
1157 if( aa .lt. 0.5 ) then
1158 do k = 1, kte
1159 if( qv(k) .gt. 2.0*qvmin ) then
1160 dum = aa*qv(k)
1161 qv(k) = qv(k) - dum
1162 endif
1163 enddo
1164 else
1165 ! For testing purposes only (not yet found in any output):
1166 ! write(*,*) 'Full moisture conservation is impossible'
1167 endif
1168 endif
1169
1170 return
1171
1172 END SUBROUTINE moisture_check2
1173
1174 END SUBROUTINE mynnedmf_wrapper_run
1175
1176!###=================================================================
1177
1178END MODULE mynnedmf_wrapper
module_bl_mynn::mynn_bl_driver
subroutine mynn_bl_driver(initflag, restart, cycling, delt, dz, dx, znt, u, v, w, th, sqv3d, sqc3d, sqi3d, sqs3d, qnc, qni, qnwfa, qnifa, qnbca, ozone, p, exner, rho, t3d, xland, ts, qsfc, ps, ust, ch, hfx, qfx, rmol, wspd, uoce, voce, qke, qke_adv, sh3d, sm3d, nchem, kdvel, ndvel, chem3d, vdep, smoke_dbg, frp, emis_ant_no, mix_chem, enh_mix, rrfs_sd, tsq, qsq, cov, rublten, rvblten, rthblten, rqvblten, rqcblten, rqiblten, rqncblten, rqniblten, rqsblten, rqnwfablten, rqnifablten, rqnbcablten, dozone, exch_h, exch_m, pblh, kpbl, el_pbl, dqke, qwt, qshear, qbuoy, qdiss, qc_bl, qi_bl, cldfra_bl, bl_mynn_tkeadvect, tke_budget, bl_mynn_cloudpdf, bl_mynn_mixlength, icloud_bl, closure, bl_mynn_edmf, bl_mynn_edmf_mom, bl_mynn_edmf_tke, bl_mynn_mixscalars, bl_mynn_output, bl_mynn_cloudmix, bl_mynn_mixqt, edmf_a, edmf_w, edmf_qt, edmf_thl, edmf_ent, edmf_qc, sub_thl3d, sub_sqv3d, det_thl3d, det_sqv3d, maxwidth, maxmf, ztop_plume, ktop_plume, spp_pbl, pattern_spp_pbl, rthraten, flag_qc, flag_qi, flag_qnc, flag_qni, flag_qs, flag_qnwfa, flag_qnifa, flag_qnbca, flag_ozone, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
This subroutine is the MYNN-EDNF PBL driver routine,which encompassed the majority of the subroutines...
Definition module_bl_mynn.F90:415
bl_mynn_common
This module defines model-specific constants/parameters.
Definition bl_mynn_common.f90:11
module_bl_mynn
This module contains the entity of MYNN-EDMF PBL scheme.
Definition module_bl_mynn.F90:252
mynnedmf_wrapper
The following references best describe the code within Olson et al. (2019, NOAA Technical Memorandum)...
Definition mynnedmf_wrapper.F90:8