CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
mp_nssl.F90
1
3
4
7module mp_nssl
8
9 use machine, only : kind_phys
11
12 implicit none
13
14 public :: mp_nssl_init, mp_nssl_run
15
16 private
17 logical :: is_initialized = .false.
18 logical :: missing_vars_global = .false.
19 real :: nssl_qccn
20
21 contains
22
29 subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, &
30 mpirank, mpiroot,mpicomm, &
31 qc, qr, qi, qs, qh, &
32 ccw, crw, cci, csw, chw, vh, &
33 con_g, con_rd, con_cp, con_rv, &
34 con_t0c, con_cliq, con_csol, con_eps, &
35 imp_physics, imp_physics_nssl, &
36 nssl_cccn, nssl_alphah, nssl_alphahl, &
37 nssl_alphar, nssl_ehw0, nssl_ehlw0, &
38 nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment )
39
40
42#ifdef MPI
43 use mpi_f08
44#endif
45
46 implicit none
47
48 integer, intent(in) :: ncol
49 integer, intent(in) :: nlev
50 character(len=*), intent( out) :: errmsg
51 integer, intent( out) :: errflg
52 integer, intent(in) :: threads
53 logical, intent(in) :: restart
54 real(kind_phys), intent(in) :: con_g, con_rd, con_cp, con_rv, &
55 con_t0c, con_cliq, con_csol, con_eps
56
57 integer, intent(in) :: mpirank
58 integer, intent(in) :: mpiroot
59 type(mpi_comm), intent(in) :: mpicomm
60 integer, intent(in) :: imp_physics
61 integer, intent(in) :: imp_physics_nssl
62 real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl
63 real(kind_phys), intent(in) :: nssl_alphar, nssl_ehw0, nssl_ehlw0
64 logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment
65
66 real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev)
67 real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev)
68 real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev)
69 real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev)
70 real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel
71 real(kind_phys), intent(inout), optional :: ccw(:,:) !(1:ncol,1:nlev)
72 real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev)
73 real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev)
74 real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev)
75 real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number
76 real(kind_phys), intent(inout), optional :: vh (:,:) !(1:ncol,1:nlev) graupel volume
77
78 ! Local variables: dimensions used in nssl_init
79 integer :: ims,ime, jms,jme, kms,kme, nx, nz, i,k
80 real(kind_phys) :: nssl_params(20)
81 integer :: ihailv,ipc
82 real(kind_phys), parameter :: qmin = 1.e-12
83 integer :: ierr
84 logical :: missing_vars = .false.
85
86
87 ! Initialize the CCPP error handling variables
88 errflg = 0
89 errmsg = ''
90
91! write(0,*) 'nssl_init: nlev,ncol,rank = ',nlev,ncol,mpirank
92
93 if ( is_initialized ) return
94
95 IF ( .not. is_initialized ) THEN ! only do this on first call
96 if (mpirank==mpiroot) then
97 write(0,*) ' ----------------------------------------------------------------------------------------------------------------'
98 write(0,*) ' --- CCPP NSSL MP scheme init ---'
99 write(0,*) ' ----------------------------------------------------------------------------------------------------------------'
100 write(6,*) ' ----------------------------------------------------------------------------------------------------------------'
101 write(6,*) ' --- CCPP NSSL MP scheme init ---'
102 write(6,*) ' ----------------------------------------------------------------------------------------------------------------'
103 end if
104
105! update this when ccn_flag is active?
106 if ( imp_physics /= imp_physics_nssl ) then
107 write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from NSSL"
108 errflg = 1
109 return
110 end if
111
112 ! set some physical constants in NSSL microphysics to be consistent with parent model
114 con_g, con_rd, con_cp, con_rv, con_t0c, con_cliq, con_csol, con_eps )
115
116
117 ! Set internal dimensions
118 ims = 1
119 ime = ncol
120 nx = ncol
121 jms = 1
122 jme = 1
123 kms = 1
124 kme = nlev
125 nz = nlev
126
127
128 nssl_params(:) = 0.0
129 ! nssl_params(1) = nssl_cccn ! use direct interface instead
130 ! nssl_params(2) = nssl_alphah ! use direct interface instead
131 ! nssl_params(3) = nssl_alphahl ! use direct interface instead
132 nssl_params(4) = 4.e5 ! nssl_cnoh -- not used for 2-moment
133 nssl_params(5) = 4.e4 ! nssl_cnohl-- not used for 2-moment
134 nssl_params(6) = 4.e5 ! nssl_cnor-- not used for 2-moment
135 nssl_params(7) = 4.e6 ! nssl_cnos-- not used for 2-moment
136 nssl_params(8) = 500. ! nssl_rho_qh
137 nssl_params(9) = 800. ! nssl_rho_qhl
138 nssl_params(10) = 100. ! nssl_rho_qs
139
140 nssl_qccn = nssl_cccn/1.225
141 ! if (mpirank==mpiroot) then
142 ! write(*,*) 'nssl_init: nssl_qccn = ',nssl_qccn
143 ! endif
144
145 IF ( nssl_hail_on ) THEN
146 ihailv = 1
147 ELSE
148 ihailv = -1
149 ENDIF
150
151 IF ( nssl_3moment ) THEN
152 ipc = 8
153 ELSE
154 ipc = 5
155 ENDIF
156
157! write(0,*) 'call nssl_2mom_init'
158 CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, &
159 ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, &
160 nssl_alphar=nssl_alphar, &
161 nssl_alphah=nssl_alphah, &
162 nssl_alphahl=nssl_alphahl, &
163 nssl_cccn=nssl_cccn, &
164 errflg=errflg,myrank=mpirank,mpiroot=mpiroot)
165
166 ! For restart runs, the init is done here
167 if (restart) then
168
169 ! For restart, check if the IC is from a different scheme that does not have all the needed variables
170 missing_vars = .false.
171 IF ( any( qc > qmin .and. ccw == 0.0 ) ) missing_vars = .true.
172 IF ( .not. missing_vars .and. any( qi > qmin .and. cci == 0.0 ) ) missing_vars = .true.
173 IF ( .not. missing_vars .and. any( qs > qmin .and. csw == 0.0 ) ) missing_vars = .true.
174 IF ( .not. missing_vars .and. any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true.
175 IF ( .not. missing_vars .and. any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true.
176
177#ifdef MPI
178 call mpi_allreduce(missing_vars, missing_vars_global, 1, mpi_logical, mpi_lor, mpicomm, ierr)
179#endif
180
181 is_initialized = .true.
182 return
183 end if
184
185! Other initialization operation here....
186
187 is_initialized = .true.
188
189 ENDIF ! .not. is_initialized
190
191 return
192
193 end subroutine mp_nssl_init
195
202 subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, &
203 spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, &
204 ccw, crw, cci, csw, chw, chl, vh, vhl, &
205 zrw, zhw, zhl, &
206 tgrs, prslk, prsl, phii, omega, dtp, &
207 prcp, rain, graupel, ice, snow, sr, &
208 refl_10cm, do_radar_ref, first_time_step, restart, &
209 re_cloud, re_ice, re_snow, re_rain, &
210 nleffr, nieffr, nseffr, nreffr, &
211 imp_physics, convert_dry_rho, &
212 imp_physics_nssl, nssl_ccn_on, &
213 nssl_hail_on, nssl_invertccn, nssl_3moment, &
214 ntccn, ntccna, &
215 errflg, errmsg)
216
217 use module_mp_nssl_2mom, only: calcnfromq, na
218
219 implicit none
220 integer, intent(in) :: ncol, nlev
221 real(kind_phys), intent(in ) :: con_g
222 real(kind_phys), intent(in ) :: con_rd
223 integer, intent(in) :: mpirank
224 ! Hydrometeors
225 logical, intent(in ) :: convert_dry_rho
226 real(kind_phys), intent(inout) :: spechum(:,:) !(1:ncol,1:nlev)
227 real(kind_phys), intent(inout), optional :: cccn(:,:) !(1:ncol,1:nlev)
228 real(kind_phys), intent(inout), optional :: cccna(:,:) !(1:ncol,1:nlev)
229 real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev)
230 real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev)
231 real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev)
232 real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev)
233 real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel
234 real(kind_phys), intent(inout), optional :: qhl(:,:) !(1:ncol,1:nlev) hail
235 real(kind_phys), intent(inout), optional :: ccw(:,:) !(1:ncol,1:nlev)
236 real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev)
237 real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev)
238 real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev)
239 real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number
240 real(kind_phys), intent(inout), optional :: chl(:,:) !(1:ncol,1:nlev) hail number
241 real(kind_phys), intent(inout), optional :: vh (:,:) !(1:ncol,1:nlev) graupel volume
242 real(kind_phys), intent(inout), optional :: vhl(:,:) !(1:ncol,1:nlev) hail volume
243 real(kind_phys), intent(inout), optional :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity
244 real(kind_phys), intent(inout), optional :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity
245 real(kind_phys), intent(inout), optional :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity
246 ! State variables and timestep information
247 real(kind_phys), intent(inout) :: tgrs (:,:) !(1:ncol,1:nlev)
248 real(kind_phys), intent(in ) :: prsl (:,:) !(1:ncol,1:nlev)
249 real(kind_phys), intent(in ) :: prslk(:,:) !(1:ncol,1:nlev)
250 real(kind_phys), intent(in ) :: phii (:,:) !(1:ncol,1:nlev+1)
251 real(kind_phys), intent(in ) :: omega(:,:) !(1:ncol,1:nlev)
252 real(kind_phys), intent(in ) :: dtp
253 ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip
254 real(kind_phys), intent( out) :: prcp (:) !(1:ncol)
255 real(kind_phys), intent( out), optional :: rain (:) !(1:ncol)
256 real(kind_phys), intent( out), optional :: graupel(:) !(1:ncol)
257 real(kind_phys), intent( out), optional :: ice (:) !(1:ncol)
258 real(kind_phys), intent( out), optional :: snow (:) !(1:ncol)
259 real(kind_phys), intent( out) :: sr (:) !(1:ncol)
260 ! Radar reflectivity
261 real(kind_phys), intent(inout) :: refl_10cm(:,:) !(1:ncol,1:nlev)
262 logical, intent(in ) :: do_radar_ref, first_time_step
263 logical, intent(in) :: restart
264 ! Cloud effective radii
265 real(kind_phys), intent(inout), optional :: re_cloud(:,:) ! (1:ncol,1:nlev)
266 real(kind_phys), intent(inout), optional :: re_ice(:,:) ! (1:ncol,1:nlev)
267 real(kind_phys), intent(inout), optional :: re_snow(:,:) ! (1:ncol,1:nlev)
268 real(kind_phys), intent(inout), optional :: re_rain(:,:) ! (1:ncol,1:nlev)
269 integer, intent(in) :: nleffr, nieffr, nseffr, nreffr
270 integer, intent(in) :: imp_physics
271 integer, intent(in) :: imp_physics_nssl
272 logical, intent(in) :: nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment
273 integer, intent(in) :: ntccn, ntccna
274
275 integer, intent(out) :: errflg
276 character(len=*), intent(out) :: errmsg
277
278
279 ! Local variables
280
281 ! Air density
282 real(kind_phys) :: rho(1:ncol,1:nlev)
283 ! Hydrometeors
284 real(kind_phys) :: qv_mp(1:ncol,1:nlev)
285 real(kind_phys) :: qc_mp(1:ncol,1:nlev)
286 real(kind_phys) :: qr_mp(1:ncol,1:nlev)
287 real(kind_phys) :: qi_mp(1:ncol,1:nlev)
288 real(kind_phys) :: qs_mp(1:ncol,1:nlev)
289 real(kind_phys) :: qh_mp(1:ncol,1:nlev)
290 real(kind_phys) :: qhl_mp(1:ncol,1:nlev)
291 real(kind_phys) :: nc_mp(1:ncol,1:nlev)
292 real(kind_phys) :: nr_mp(1:ncol,1:nlev)
293 real(kind_phys) :: ni_mp(1:ncol,1:nlev)
294 real(kind_phys) :: ns_mp(1:ncol,1:nlev)
295 real(kind_phys) :: nh_mp(1:ncol,1:nlev)
296 real(kind_phys) :: nhl_mp(1:ncol,1:nlev)
297 real(kind_phys) :: cn_mp(1:ncol,1:nlev)
298 real(kind_phys) :: cna_mp(1:ncol,1:nlev)
299 real(kind_phys) :: cccn_mp(1:ncol,1:nlev)
300 real(kind_phys) :: cccna_mp(1:ncol,1:nlev)
301 real(kind_phys) :: vh_mp(1:ncol,1:nlev)
302 ! create temporaries for hail in case it does not exist
303 !real(kind_phys) :: chl_mp(1:ncol,1:nlev) !< kg-1 (number mixing ratio)
304 real(kind_phys) :: vhl_mp(1:ncol,1:nlev)
305 real(kind_phys) :: zrw_mp(1:ncol,1:nlev)
306 real(kind_phys) :: zhw_mp(1:ncol,1:nlev)
307 real(kind_phys) :: zhl_mp(1:ncol,1:nlev)
308 ! Vertical velocity and level width
309 real(kind_phys) :: w(1:ncol,1:nlev)
310 real(kind_phys) :: dz(1:ncol,1:nlev)
311
312 ! Rain/snow/graupel fall amounts
313 real(kind_phys) :: rain_mp(1:ncol) ! mm, dummy, not used
314 real(kind_phys) :: graupel_mp(1:ncol) ! mm, dummy, not used
315 real(kind_phys) :: ice_mp(1:ncol) ! mm, dummy, not used
316 real(kind_phys) :: snow_mp(1:ncol) ! mm, dummy, not used
317 real(kind_phys) :: delta_rain_mp(1:ncol) ! mm
318 real(kind_phys) :: delta_graupel_mp(1:ncol) ! mm
319 real(kind_phys) :: delta_ice_mp(1:ncol) ! mm
320 real(kind_phys) :: delta_snow_mp(1:ncol) ! mm
321
322 real(kind_phys) :: xrain_mp(1:ncol) ! mm, dummy, not used
323 real(kind_phys) :: xgraupel_mp(1:ncol) ! mm, dummy, not used
324 real(kind_phys) :: xice_mp(1:ncol) ! mm, dummy, not used
325 real(kind_phys) :: xsnow_mp(1:ncol) ! mm, dummy, not used
326 real(kind_phys) :: xdelta_rain_mp(1:ncol) ! mm
327 real(kind_phys) :: xdelta_graupel_mp(1:ncol) ! mm
328 real(kind_phys) :: xdelta_ice_mp(1:ncol) ! mm
329 real(kind_phys) :: xdelta_snow_mp(1:ncol) ! mm
330
331 ! Radar reflectivity
332 logical :: diagflag ! must be true if do_radar_ref is true, not used otherwise
333 integer :: do_radar_ref_mp ! integer instead of logical do_radar_ref
334 ! Effective cloud radii
335 logical :: do_effective_radii
336 real(kind_phys) :: re_cloud_mp(1:ncol,1:nlev) ! m
337 real(kind_phys) :: re_ice_mp(1:ncol,1:nlev) ! m
338 real(kind_phys) :: re_snow_mp(1:ncol,1:nlev) ! m
339 real(kind_phys) :: re_rain_mp(1:ncol,1:nlev) ! m
340 integer :: has_reqc
341 integer :: has_reqi
342 integer :: has_reqs
343 integer :: has_reqr
344 ! Dimensions used in driver
345 integer :: ids,ide, jds,jde, kds,kde, &
346 ims,ime, jms,jme, kms,kme, &
347 its,ite, jts,jte, kts,kte, i,j,k
348 integer :: itimestep ! timestep counter
349 integer :: ntmul, n
350 real(kind_phys), parameter :: dtpmax = 60. ! allow up to dt=75 (1.25*60)
351 real(kind_phys) :: dtptmp
352 integer, parameter :: ndebug = 0
353 logical :: invertccn
354 real(kind_phys) :: cwmas
355
356 real(kind_phys), allocatable :: an(:,:,:,:) ! temporary scalar array
357
358
359
360 errflg = 0
361 errmsg = ''
362
363! write(0,*) 'nssl_run: nlev,ncol,rank = ',nlev,ncol,mpirank
364
365 IF ( ndebug >= 1 ) write(0,*) 'In physics nssl_run'
366
367
368 ! Check initialization state
369 if (.not.is_initialized) then
370 write(errmsg, fmt='((a))') 'mp_nssl_run called before mp_nssl_init'
371 errflg = 1
372 return
373 end if
374
375 invertccn = nssl_invertccn
376
378 ! NOTE: Implied loops!
379 qv_mp = spechum/(1.0_kind_phys-spechum)
380 IF ( convert_dry_rho ) THEN
381 qc_mp = qc/(1.0_kind_phys-spechum)
382 qr_mp = qr/(1.0_kind_phys-spechum)
383 qi_mp = qi/(1.0_kind_phys-spechum)
384 qs_mp = qs/(1.0_kind_phys-spechum)
385 qh_mp = qh/(1.0_kind_phys-spechum)
386
387 IF ( nssl_ccn_on ) cccn_mp = cccn/(1.0_kind_phys-spechum)
388! cccna_mp = cccna/(1.0_kind_phys-spechum)
389 nc_mp = ccw/(1.0_kind_phys-spechum)
390 nr_mp = crw/(1.0_kind_phys-spechum)
391 ni_mp = cci/(1.0_kind_phys-spechum)
392 ns_mp = csw/(1.0_kind_phys-spechum)
393 nh_mp = chw/(1.0_kind_phys-spechum)
394 vh_mp = vh/(1.0_kind_phys-spechum)
395 IF ( nssl_3moment ) THEN
396 zrw_mp = zrw/(1.0_kind_phys-spechum)
397 zhw_mp = zhw/(1.0_kind_phys-spechum)
398 ENDIF
399 IF ( nssl_hail_on ) THEN
400 qhl_mp = qhl/(1.0_kind_phys-spechum)
401 nhl_mp = chl/(1.0_kind_phys-spechum)
402 vhl_mp = vhl/(1.0_kind_phys-spechum)
403 IF ( nssl_3moment ) THEN
404 zhl_mp = zhl/(1.0_kind_phys-spechum)
405 ENDIF
406 ENDIF
407 ELSE
408! qv_mp = spechum ! /(1.0_kind_phys-spechum)
409 qc_mp = qc ! /(1.0_kind_phys-spechum)
410 qr_mp = qr ! /(1.0_kind_phys-spechum)
411 qi_mp = qi ! /(1.0_kind_phys-spechum)
412 qs_mp = qs ! /(1.0_kind_phys-spechum)
413 qh_mp = qh ! /(1.0_kind_phys-spechum)
414 IF ( nssl_ccn_on ) cccn_mp = cccn
415! cccna_mp = cccna
416 nc_mp = ccw
417 nr_mp = crw
418 ni_mp = cci
419 ns_mp = csw
420 nh_mp = chw
421 vh_mp = vh
422 IF ( nssl_3moment ) THEN
423 zrw_mp = zrw
424 zhw_mp = zhw
425 ENDIF
426 IF ( nssl_hail_on ) THEN
427 qhl_mp = qhl ! /(1.0_kind_phys-spechum)
428 nhl_mp = chl
429 vhl_mp = vhl
430 IF ( nssl_3moment ) THEN
431 zhl_mp = zhl
432 ENDIF
433 ENDIF
434
435 ENDIF
436
437 IF ( nssl_hail_on ) THEN
438! nhl_mp = chl
439! vhl_mp = vhl
440 ELSE
441 qhl_mp = 0
442 nhl_mp = 0
443 vhl_mp = 0
444 ENDIF
445
446 IF ( .false. ) THEN
447 write(6,*) 'nsslrun: qc,max ccw = ',mpirank,maxval(qc_mp),maxval(nc_mp),sum(nc_mp)
448 IF ( mpirank == 1 ) THEN
449 DO k=1,nlev
450 DO i=1,ncol
451 IF ( qc_mp(i,k) > 1.e-6 .and. nc_mp(i,k) <= 1.e-9 ) THEN
452 write(6,*) 'i,k,qc,nc,ccn = ',i,k,qc_mp(i,k),nc_mp(i,k),cccn_mp(i,k)
453 ENDIF
454 ENDDO
455 ENDDO
456 ENDIF
457 ENDIF
458
459 ! IF ( first_time_step ) THEN
460 ! write(0,*) 'mp_nssl_run: qi,qs,qh maxval: ',maxval(qi),maxval(qs),maxval(qh)
461 ! write(0,*) 'mp_nssl_run: ni,ns,nh maxval: ',maxval(ni_mp),maxval(ns_mp),maxval(nh_mp)
462 ! ENDIF
463
464
466 rho = prsl/(con_rd*tgrs)
467
469 w = -omega/(rho*con_g)
470
472 dz = (phii(:,2:nlev+1) - phii(:,1:nlev)) / con_g
473
474 ! Accumulated values inside scheme, not used;
475 ! only use delta and add to inout variables (different units)
476 rain_mp = 0
477 graupel_mp = 0
478 ice_mp = 0
479 snow_mp = 0
480 delta_rain_mp = 0
481 delta_graupel_mp = 0
482 delta_ice_mp = 0
483 delta_snow_mp = 0
484 xrain_mp = 0
485 xgraupel_mp = 0
486 xice_mp = 0
487 xsnow_mp = 0
488 xdelta_rain_mp = 0
489 xdelta_graupel_mp = 0
490 xdelta_ice_mp = 0
491 xdelta_snow_mp = 0
492 IF ( ndebug > 1 ) THEN
493 write(*,*) 'Max q before micro'
494 write(*,*) 'qc = ',1000.*maxval(qc_mp)
495 write(*,*) 'qr = ',1000.*maxval(qr_mp)
496 write(*,*) 'qi = ',1000.*maxval(qi_mp)
497 write(*,*) 'qs = ',1000.*maxval(qs_mp)
498 write(*,*) 'qh = ',1000.*maxval(qh_mp)
499 IF ( nssl_hail_on ) write(*,*) 'qhl = ',1000.*maxval(qhl_mp)
500 write(*,*) 'ccw = ',1.e-6*maxval(ccw*rho)
501 ENDIF
502
503 ! Flags for calculating radar reflectivity; diagflag is redundant
504 if (do_radar_ref) then
505 diagflag = .true.
506 do_radar_ref_mp = 1
507 else
508 diagflag = .false.
509 do_radar_ref_mp = 0
510 end if
511
512 do_effective_radii = .false.
513 IF ( nleffr > 0 .and. nieffr > 0 .and. nseffr > 0 .and. nreffr > 0 ) THEN
514 ! if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then
515 do_effective_radii = .true.
516 has_reqc = 1
517 has_reqi = 1
518 has_reqs = 1
519 has_reqr = 1
520 else if (nleffr < 1 .and. nieffr < 1 .and. nseffr < 1 .and. nreffr < 1 ) then
521 do_effective_radii = .false.
522 has_reqc = 0
523 has_reqi = 0
524 has_reqs = 0
525 has_reqr = 0
526 else
527 write(errmsg,fmt='(*(a))') 'Logic error in mp_nssl_run:', &
528 ' hydrometeor radius calculation logic problem'
529 errflg = 1
530 return
531 end if
532 ! Initialize to zero, intent(out) variables
533 re_cloud_mp = 0
534 re_ice_mp = 0
535 re_snow_mp = 0
536 re_rain_mp = 0
537
538 ! Set internal dimensions
539 ids = 1
540 ims = 1
541 its = 1
542 ide = ncol
543 ime = ncol
544 ite = ncol
545 jds = 1
546 jms = 1
547 jts = 1
548 jde = 1
549 jme = 1
550 jte = 1
551 kds = 1
552 kms = 1
553 kts = 1
554 kde = nlev
555 kme = nlev
556 kte = nlev
557
558
559 IF ( ndebug >= 1 ) write(0,*) 'call nssl_2mom_driver'
560
561 IF ( dtp > 1.25001*dtpmax ) THEN
562 ntmul = max(2, nint( dtp/dtpmax ) )
563 dtptmp = dtp/ntmul
564 ELSE
565 dtptmp = dtp
566 ntmul = 1
567 ENDIF
568
569 IF ( first_time_step .and. ( .not. restart .or. missing_vars_global ) ) THEN
570 itimestep = 0 ! gets incremented to 1 in call loop
571 IF ( nssl_ccn_on ) THEN
572 IF ( invertccn ) THEN
573 cccn_mp = 0
574 !cccn = nssl_qccn
575 ELSE
576 cccn_mp = nssl_qccn
577 ENDIF
578 ENDIF
579 ELSE
580 itimestep = 2
581 ENDIF
582
583 IF ( .false. ) THEN ! disable for now, as logic in the NSSL driver does this, but may switch back to here
584 ! incoming droplet field may have some inconsistent number concentrations (e.g., from PBL)
585 ! so check for that, otherwise mass may be zapped into vapor
586 allocate( an(ncol,1,nlev,na) )
587 an(:,:,:,:) = 0.0 ! needed for workspace in routine
588
589 cwmas = 1000.*0.523599*(2.*9.e-6)**3
590
591 call calcnfromq(nx=ncol,ny=1,nz=nlev,an=an,na=na,nor=0,norz=0,dn=rho, &
592 & qcw=qc_mp,qci=qi_mp, &
593 & ccw=nc_mp,cci=ni_mp, &
594 & cccn=cccn_mp,qv=qv_mp, invertccn_flag=nssl_invertccn, cwmasin=cwmas )
595
596 IF ( .false. ) THEN
597 write(6,*) 'nsslrun2: qc,max ccw = ',mpirank,maxval(qc_mp),maxval(nc_mp),sum(nc_mp)
598 IF ( mpirank == 1 ) THEN
599 DO k=1,nlev
600 DO i=1,ncol
601 IF ( qc_mp(i,k) > 1.e-6 .and. nc_mp(i,k) <= 1.e-9 ) THEN
602 write(6,*) 'i2,k,qc,nc,ccn = ',i,k,qc_mp(i,k),nc_mp(i,k),cccn_mp(i,k)
603 ENDIF
604 ENDDO
605 ENDDO
606 ENDIF
607 ENDIF
608
609
610 deallocate( an )
611 ENDIF
612
613 IF ( nssl_ccn_on ) THEN
614 IF ( invertccn ) THEN
615 ! cn_mp = Max(0.0, nssl_qccn - Max(0.0,cccn_mp))
616 ! Flip CCN concentrations from 'activated' to 'unactivated' (allows BC condition to be zero)
617 cn_mp = nssl_qccn - cccn_mp
618 cn_mp = max(0.0_kind_phys, cn_mp)
619
620 ELSE
621 cn_mp = cccn_mp
622 ENDIF
623 IF ( ntccna > 0 ) THEN
624 ! not in use yet
625! cna_mp = cccna
626 ELSE
627 cna_mp = 0
628 ENDIF
629 ENDIF
630
631 IF ( .true. ) THEN
632 DO n = 1,ntmul
633
634 itimestep = itimestep + 1
635
636
637
638 IF ( nssl_ccn_on ) THEN
639
640 CALL nssl_2mom_driver( &
641 itimestep=itimestep, &
642 ! TH=th, &
643 tt=tgrs, &
644 qv=qv_mp, &
645 qc=qc_mp, &
646 qr=qr_mp, &
647 qi=qi_mp, &
648 qs=qs_mp, &
649 qh=qh_mp, &
650 qhl=qhl_mp, &
651 ccw=nc_mp, &
652 crw=nr_mp, &
653 cci=ni_mp, &
654 csw=ns_mp, &
655 chw=nh_mp, &
656 chl=nhl_mp, &
657 vhw=vh_mp, &
658 vhl=vhl_mp, &
659 cn=cn_mp, &
660 zrw=zrw_mp, &
661 zhw=zhw_mp, &
662 zhl=zhl_mp, &
663! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use
664 cna=cna_mp, f_cna=.false. , &
665 pii=prslk, &
666 p=prsl, &
667 w=w, &
668 dz=dz, &
669 dtp=dtptmp, &
670 dn=rho, &
671 rainnc=xrain_mp, rainncv=xdelta_rain_mp, &
672 snownc=xsnow_mp, snowncv=xdelta_snow_mp, &
673 grplnc=xgraupel_mp, &
674 grplncv=xdelta_graupel_mp, &
675 sr=sr, &
676 dbz = refl_10cm, &
677 diagflag = diagflag, &
678 errmsg=errmsg,errflg=errflg, &
679 re_cloud=re_cloud_mp, &
680 re_ice=re_ice_mp, &
681 re_snow=re_snow_mp, &
682 re_rain=re_rain_mp, &
683 has_reqc=has_reqc, &
684 has_reqi=has_reqi, &
685 has_reqs=has_reqs, &
686 has_reqr=has_reqr, &
687 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
688 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
689 its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte &
690 )
691
692 ELSE
693
694 CALL nssl_2mom_driver( &
695 itimestep=itimestep, &
696 ! TH=th, &
697 tt=tgrs, &
698 qv=qv_mp, &
699 qc=qc_mp, &
700 qr=qr_mp, &
701 qi=qi_mp, &
702 qs=qs_mp, &
703 qh=qh_mp, &
704 qhl=qhl_mp, &
705 ccw=nc_mp, &
706 crw=nr_mp, &
707 cci=ni_mp, &
708 csw=ns_mp, &
709 chw=nh_mp, &
710 chl=nhl_mp, &
711 vhw=vh_mp, &
712 vhl=vhl_mp, &
713! cn=cn_mp, &
714 zrw=zrw_mp, &
715 zhw=zhw_mp, &
716 zhl=zhl_mp, &
717! cna=cna_mp, f_cna=( ntccna > 0 ), & ! for future use
718! cna=cna_mp, f_cna=.false. , &
719 pii=prslk, &
720 p=prsl, &
721 w=w, &
722 dz=dz, &
723 dtp=dtptmp, &
724 dn=rho, &
725 rainnc=xrain_mp, rainncv=xdelta_rain_mp, &
726 snownc=xsnow_mp, snowncv=xdelta_snow_mp, &
727 grplnc=xgraupel_mp, &
728 grplncv=xdelta_graupel_mp, &
729 sr=sr, &
730 dbz = refl_10cm, &
731 diagflag = diagflag, &
732 errmsg=errmsg,errflg=errflg, &
733 re_cloud=re_cloud_mp, &
734 re_ice=re_ice_mp, &
735 re_snow=re_snow_mp, &
736 re_rain=re_rain_mp, &
737 has_reqc=has_reqc, &
738 has_reqi=has_reqi, &
739 has_reqs=has_reqs, &
740 has_reqr=has_reqr, &
741 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
742 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
743 its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte &
744 )
745
746 ENDIF
747
748 DO i = 1,ncol
749 delta_rain_mp(i) = delta_rain_mp(i) + xdelta_rain_mp(i) ! this is liquid equivalent of all precip
750 delta_graupel_mp(i) = delta_graupel_mp(i) + xdelta_graupel_mp(i) ! this is liquid equivalent of graupel
751 delta_ice_mp(i) = delta_ice_mp(i) + xdelta_ice_mp(i)
752 delta_snow_mp(i) = delta_snow_mp(i) + xdelta_snow_mp(i)
753 ENDDO
754
755 ENDDO
756
757 ENDIF
758
759
760 IF ( nssl_ccn_on ) THEN
761 IF ( invertccn ) THEN
762 cccn_mp = max(0.0_kind_phys, nssl_qccn - cn_mp )
763! cccn_mp = nssl_qccn - cn_mp
764 ELSE
765 cccn_mp = cn_mp
766 ENDIF
767! cccna = cna_mp ! cna not in use yet for ccpp
768 ENDIF
769
770! test code
771! IF ( ntccna > 1 .and. do_effective_radii ) THEN
772! cccna = re_ice_mp*1.0E6_kind_phys
773! ENDIF
774
775 IF ( ndebug > 1 ) write(0,*) 'done nssl_2mom_driver'
776
777 if (errflg/=0) return
778
779 IF ( ndebug > 1 ) THEN
780 write(*,*) 'Max q after micro'
781 write(*,*) 'qc = ',1000.*maxval(qc_mp)
782 write(*,*) 'qr = ',1000.*maxval(qr_mp)
783 write(*,*) 'qi = ',1000.*maxval(qi_mp)
784 write(*,*) 'qs = ',1000.*maxval(qs_mp)
785 write(*,*) 'qh = ',1000.*maxval(qh_mp)
786 IF ( nssl_hail_on ) THEN
787 write(*,*) 'qhl = ',1000.*maxval(qhl_mp)
788 ENDIF
789 write(*,*) 'ccw = ',1.e-6*maxval(ccw*rho)
790 IF ( 1000.*maxval(qc_mp) > 0.5 .or. 1000.*maxval(qi_mp) > 0.09 .or. 1000.*maxval(qs_mp) > 0.1 ) THEN
791 IF ( nssl_ccn_on ) THEN
792 write(*,*) 'qc, ccn, ccw, tt, qi+qs by height'
793 DO k = 1,nlev
794 write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, ccw(1,k)*rho(1,k)*1.e-6, tgrs(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6
795 ENDDO
796 ELSE
797 write(*,*) 'qc, ccn, ccw, tt, qi+qs by height'
798 DO k = 1,nlev
799 write(*,*) qc_mp(1,k)*1000., cccn(1,k)*rho(1,k)*1.e-6, 0.0, tgrs(1,k), (qs_mp(1,k)+qi_mp(1,k))*1000. ! cccn(1,k)*1.e-6
800 ENDDO
801 ENDIF
802 ENDIF
803 ENDIF
804
805
807 spechum = qv_mp/(1.0_kind_phys+qv_mp)
808 IF ( convert_dry_rho ) THEN
809 qc = qc_mp/(1.0_kind_phys+qv_mp)
810 qr = qr_mp/(1.0_kind_phys+qv_mp)
811 qi = qi_mp/(1.0_kind_phys+qv_mp)
812 qs = qs_mp/(1.0_kind_phys+qv_mp)
813 qh = qh_mp/(1.0_kind_phys+qv_mp)
814 IF ( nssl_ccn_on ) cccn = cccn_mp/(1.0_kind_phys+qv_mp)
815! cccna = cccna_mp/(1.0_kind_phys+qv_mp)
816 ccw = nc_mp/(1.0_kind_phys+qv_mp)
817 crw = nr_mp/(1.0_kind_phys+qv_mp)
818 cci = ni_mp/(1.0_kind_phys+qv_mp)
819 csw = ns_mp/(1.0_kind_phys+qv_mp)
820 chw = nh_mp/(1.0_kind_phys+qv_mp)
821 vh = vh_mp/(1.0_kind_phys+qv_mp)
822 IF ( nssl_3moment ) THEN
823 zrw = zrw_mp/(1.0_kind_phys+qv_mp)
824 zhw = zhw_mp/(1.0_kind_phys+qv_mp)
825 ENDIF
826 IF ( nssl_hail_on ) THEN
827 qhl = qhl_mp/(1.0_kind_phys+qv_mp)
828 chl = nhl_mp/(1.0_kind_phys+qv_mp)
829 vhl = vhl_mp/(1.0_kind_phys+qv_mp)
830 IF ( nssl_3moment ) THEN
831 zhl = zhl_mp/(1.0_kind_phys+qv_mp)
832 ENDIF
833 ENDIF
834 ELSE
835! spechum = qv_mp ! /(1.0_kind_phys+qv_mp)
836 qc = qc_mp ! /(1.0_kind_phys+qv_mp)
837 qr = qr_mp ! /(1.0_kind_phys+qv_mp)
838 qi = qi_mp ! /(1.0_kind_phys+qv_mp)
839 qs = qs_mp ! /(1.0_kind_phys+qv_mp)
840 qh = qh_mp ! /(1.0_kind_phys+qv_mp)
841 IF ( nssl_ccn_on ) cccn = cccn_mp
842! cccna = cccna_mp
843 ccw = nc_mp
844 crw = nr_mp
845 cci = ni_mp
846 csw = ns_mp
847 chw = nh_mp
848 vh = vh_mp
849 IF ( nssl_3moment ) THEN
850 zrw = zrw_mp
851 zhw = zhw_mp
852 ENDIF
853 IF ( nssl_hail_on ) THEN
854 qhl = qhl_mp ! /(1.0_kind_phys+qv_mp)
855 chl = nhl_mp
856 vhl = vhl_mp
857 IF ( nssl_3moment ) THEN
858 zhl = zhl_mp
859 ENDIF
860 ENDIF
861
862 ENDIF
863
864! write(0,*) 'mp_nssl: done q'
865
867 ! "rain" in NSSL MP refers to precipitation (total of liquid rainfall+snow+graupel+ice)
868
869 prcp = max(0.0, delta_rain_mp/1000.0_kind_phys)
870 graupel = max(0.0, delta_graupel_mp/1000.0_kind_phys)
871 ice = max(0.0, delta_ice_mp/1000.0_kind_phys)
872 snow = max(0.0, delta_snow_mp/1000.0_kind_phys)
873 rain = max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys)
874
875! write(0,*) 'mp_nssl: done precip'
876
877 if (do_effective_radii) then
878 ! Convert m to micron
879 re_cloud = re_cloud_mp*1.0e6_kind_phys
880 re_ice = re_ice_mp*1.0e6_kind_phys
881 re_snow = re_snow_mp*1.0e6_kind_phys
882 re_rain = re_rain_mp*1.0e6_kind_phys
883 end if
884
885 IF ( ndebug >= 1 ) write(0,*) 'mp_nssl: end'
886
887 end subroutine mp_nssl_run
889
890end module mp_nssl
subroutine, public nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl, cnuf, f_cnuf, zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, qsw, qhw, qhlw, tt, th, pii, p, w, dn, dz, dtp, itimestep, is_theta_or_temp, ntmul, ntcnt, lastloop, rainnc, rainncv, dx, dy, axtra, snownc, snowncv, grplnc, grplncv, sr, hailnc, hailncv, hail_maxk1, hail_max2d, nwp_diagnostics, tkediss, re_cloud, re_ice, re_snow, re_rain, re_graup, re_hail, has_reqc, has_reqi, has_reqs, has_reqr, has_reqg, has_reqh, rainncw2, rainnci2, dbz, vzf, compdbz, rscghis_2d, rscghis_2dp, rscghis_2dn, scr, scw, sci, scs, sch, schl, sctot, elec_physics, induc, elecz, scion, sciona, noninduc, noninducp, noninducn, pcc2, pre2, depsubr, mnucf2, melr2, ctr2, rim1_2, rim2_2, rim3_2, nctr2, nnuccd2, nnucf2, effc2, effr2, effi2, effs2, effg2, fc2, fr2, fi2, fs2, fg2, fnc2, fnr2, fni2, fns2, fng2, ipelectmp, diagflag, ke_diag, errmsg, errflg, nssl_progn, wetscav_on, rainprod, evapprod, cu_used, qrcuten, qscuten, qicuten, qccuten, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
Driver subroutine that copies state data to local 2D arrays for microphysics calls.
subroutine, public calcnfromq(nx, ny, nz, an, na, nor, norz, dn, qcw, qci, qsw, qrw, qhw, qhl, ccw, cci, csw, crw, chw, chl, cccn, cccna, vhw, vhl, qv, spechum, invertccn_flag, cwmasin)
Subroutine to calculate number concentrations from initial state that has only mixing ratio.
subroutine, public nssl_2mom_init_const(con_g, con_rd, con_cp, con_rv, con_t0c, con_cliq, con_csol, con_eps)
NSSL MP subroutine to initialize physical constants provided by host model.
subroutine, public nssl_2mom_init(ims, ime, jms, jme, kms, kme, nssl_params, ipctmp, mixphase, ihvol, idoniconlytmp, nssl_graupelfallfac, nssl_hailfallfac, nssl_ehw0, nssl_ehlw0, nssl_icdx, nssl_icdxhl, nssl_icefallfac, nssl_snowfallfac, nssl_cccn, nssl_ufccn, nssl_alphah, nssl_alphahl, nssl_alphar, nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on, ccn_is_ccna, errmsg, errflg, infileunit, myrank, mpiroot)
NSSL MP setup routine (sets local options and array indices)
subroutine, public mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, mpirank, mpiroot, mpicomm, qc, qr, qi, qs, qh, ccw, crw, cci, csw, chw, vh, con_g, con_rd, con_cp, con_rv, con_t0c, con_cliq, con_csol, con_eps, imp_physics, imp_physics_nssl, nssl_cccn, nssl_alphah, nssl_alphahl, nssl_alphar, nssl_ehw0, nssl_ehlw0, nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment)
This subroutine is a wrapper around the nssl_2mom_init().
Definition mp_nssl.F90:39
subroutine, public mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, spechum, cccn, cccna, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, vh, vhl, zrw, zhw, zhl, tgrs, prslk, prsl, phii, omega, dtp, prcp, rain, graupel, ice, snow, sr, refl_10cm, do_radar_ref, first_time_step, restart, re_cloud, re_ice, re_snow, re_rain, nleffr, nieffr, nseffr, nreffr, imp_physics, convert_dry_rho, imp_physics_nssl, nssl_ccn_on, nssl_hail_on, nssl_invertccn, nssl_3moment, ntccn, ntccna, errflg, errmsg)
Definition mp_nssl.F90:216