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