CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
mp_thompson.F90
1
3
4
8
9 use mpi_f08
10 use machine, only : kind_phys
11
13 use module_mp_thompson, only : nain0, nain1, naccn0, naccn1, eps, nt_c_l, nt_c_o
14 use module_mp_thompson, only : re_qc_min, re_qc_max, re_qi_min, re_qi_max, re_qs_min, re_qs_max
15
17
18 implicit none
19
20 public :: mp_thompson_init, mp_thompson_run, mp_thompson_finalize
21
22 private
23
24 logical :: is_initialized = .false.
25
26 integer, parameter :: ext_ndiag3d = 37
27
28 contains
29
34 subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, &
35 restart, imp_physics, &
36 imp_physics_thompson, convert_dry_rho, &
37 spechum, qc, qr, qi, qs, qg, ni, nr, &
38 is_aerosol_aware, merra2_aerosol_aware, &
39 nc, nwfa2d, nifa2d, &
40 nwfa, nifa, tgrs, prsl, phil, area, &
41 aerfld, mpicomm, mpirank, mpiroot, &
42 threads, ext_diag, diag3d, &
43 errmsg, errflg)
44
45 implicit none
46
47 ! Interface variables
48 integer, intent(in ) :: ncol
49 integer, intent(in ) :: nlev
50 real(kind_phys), intent(in ) :: con_g, con_rd, con_eps
51 logical, intent(in ) :: restart
52 integer, intent(in ) :: imp_physics
53 integer, intent(in ) :: imp_physics_thompson
54 ! Hydrometeors
55 logical, intent(in ) :: convert_dry_rho
56 real(kind_phys), intent(inout) :: spechum(:,:)
57 real(kind_phys), intent(inout) :: qc(:,:)
58 real(kind_phys), intent(inout) :: qr(:,:)
59 real(kind_phys), intent(inout) :: qi(:,:)
60 real(kind_phys), intent(inout) :: qs(:,:)
61 real(kind_phys), intent(inout) :: qg(:,:)
62 real(kind_phys), intent(inout) :: ni(:,:)
63 real(kind_phys), intent(inout) :: nr(:,:)
64 ! Aerosols
65 logical, intent(in ) :: is_aerosol_aware
66 logical, intent(in ) :: merra2_aerosol_aware
67 real(kind_phys), intent(inout), optional :: nc(:,:)
68 real(kind_phys), intent(inout), optional :: nwfa(:,:)
69 real(kind_phys), intent(inout), optional :: nifa(:,:)
70 real(kind_phys), intent(inout), optional :: nwfa2d(:)
71 real(kind_phys), intent(inout), optional :: nifa2d(:)
72 real(kind_phys), intent(in) :: aerfld(:,:,:)
73 ! State variables
74 real(kind_phys), intent(in ) :: tgrs(:,:)
75 real(kind_phys), intent(in ) :: prsl(:,:)
76 real(kind_phys), intent(in ) :: phil(:,:)
77 real(kind_phys), intent(in ) :: area(:)
78 ! MPI information
79 type(mpi_comm), intent(in ) :: mpicomm
80 integer, intent(in ) :: mpirank
81 integer, intent(in ) :: mpiroot
82 ! Threading/blocking information
83 integer, intent(in ) :: threads
84 ! Extended diagnostics
85 logical, intent(in ) :: ext_diag
86 real(kind_phys), intent(in ), optional :: diag3d(:,:,:)
87 ! CCPP error handling
88 character(len=*), intent( out) :: errmsg
89 integer, intent( out) :: errflg
90
91 !
92 real(kind_phys) :: qv(1:ncol,1:nlev) ! kg kg-1 (water vapor mixing ratio)
93 real(kind_phys) :: hgt(1:ncol,1:nlev) ! m
94 real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3
95 real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1
96 real(kind_phys) :: nc_local(1:ncol,1:nlev) ! needed because nc is only allocated if is_aerosol_aware is true
97 !
98 real (kind=kind_phys) :: h_01, z1, niin3, niccn3
99 integer :: i, k
100
101 ! Initialize the CCPP error handling variables
102 errmsg = ''
103 errflg = 0
104
105 if (is_initialized) return
106
107 ! Consistency checks
108 if (imp_physics/=imp_physics_thompson) then
109 write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Thompson MP"
110 errflg = 1
111 return
112 end if
113
114 if (ext_diag) then
115 if (size(diag3d,dim=3) /= ext_ndiag3d) then
116 write(errmsg,'(*(a))') "Logic error: number of diagnostic 3d arrays from model does not match requirements"
117 errflg = 1
118 return
119 end if
120 end if
121
122 if (is_aerosol_aware .and. merra2_aerosol_aware) then
123 write(errmsg,'(*(a))') "Logic error: Only one Thompson aerosol option can be true, either is_aerosol_aware or merra2_aerosol_aware)"
124 errflg = 1
125 return
126 end if
127
128 ! Call Thompson init
129 call thompson_init(is_aerosol_aware_in=is_aerosol_aware, &
130 merra2_aerosol_aware_in=merra2_aerosol_aware, &
131 mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, &
132 threads=threads, errmsg=errmsg, errflg=errflg)
133 if (errflg /= 0) return
134
135 ! For restart runs, the init is done here
136 if (restart) then
137 is_initialized = .true.
138 return
139 end if
140
141 ! Geopotential height in m2 s-2 to height in m
142 hgt = phil/con_g
143
144 ! Ensure non-negative mass mixing ratios of all water variables
145 where(spechum<0) spechum = 1.0e-10 ! COMMENT, gthompsn, spechum should *never* be identically zero.
146 where(qc<0) qc = 0.0
147 where(qr<0) qr = 0.0
148 where(qi<0) qi = 0.0
149 where(qs<0) qs = 0.0
150 where(qg<0) qg = 0.0
151
155 if (merra2_aerosol_aware) then
156 call get_niwfa(aerfld, nifa, nwfa, ncol, nlev)
157 end if
158
159
160 qv = spechum/(1.0_kind_phys-spechum)
161
162 if (convert_dry_rho) then
163 qc = qc/(1.0_kind_phys-spechum)
164 qr = qr/(1.0_kind_phys-spechum)
165 qi = qi/(1.0_kind_phys-spechum)
166 qs = qs/(1.0_kind_phys-spechum)
167 qg = qg/(1.0_kind_phys-spechum)
168
169 ni = ni/(1.0_kind_phys-spechum)
170 nr = nr/(1.0_kind_phys-spechum)
171 if (is_aerosol_aware .or. merra2_aerosol_aware) then
172 nc = nc/(1.0_kind_phys-spechum)
173 nwfa = nwfa/(1.0_kind_phys-spechum)
174 nifa = nifa/(1.0_kind_phys-spechum)
175 end if
176 end if
177
178 ! Density of moist air in kg m-3 and inverse density of air
179 rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps))
180 orho = 1.0/rho
181
182 ! Ensure we have 1st guess ice number where mass non-zero but no number.
183 where(qi .LE. 0.0) ni=0.0
184 where(qi .GT. 0 .and. ni .LE. 0.0) ni = make_icenumber(qi*rho, tgrs) * orho
185 where(qi .EQ. 0.0 .and. ni .GT. 0.0) ni=0.0
186
187 ! Ensure we have 1st guess rain number where mass non-zero but no number.
188 where(qr .LE. 0.0) nr=0.0
189 where(qr .GT. 0 .and. nr .LE. 0.0) nr = make_rainnumber(qr*rho, tgrs) * orho
190 where(qr .EQ. 0.0 .and. nr .GT. 0.0) nr=0.0
191
192
193 !..Check for existing aerosol data, both CCN and IN aerosols. If missing
194 !.. fill in just a basic vertical profile, somewhat boundary-layer following.
195 if (is_aerosol_aware) then
196
197 ! Potential cloud condensation nuclei (CCN)
198 if (maxval(nwfa) .lt. eps) then
199 if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosols.'
200 do i = 1, ncol
201 if (hgt(i,1).le.1000.0) then
202 h_01 = 0.8
203 elseif (hgt(i,1).ge.2500.0) then
204 h_01 = 0.01
205 else
206 h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0)
207 endif
208 niccn3 = -1.0*alog(naccn1/naccn0)/h_01
209 nwfa(i,1) = naccn1+naccn0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niccn3)
210 z1 = hgt(i,2)-hgt(i,1)
211 nwfa2d(i) = nwfa(i,1) * 0.000196 * (50./z1)
212 do k = 2, nlev
213 nwfa(i,k) = naccn1+naccn0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niccn3)
214 enddo
215 enddo
216 else
217 if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.'
218 if (maxval(nwfa2d) .lt. eps) then
219 !+---+-----------------------------------------------------------------+
220 !..Scale the lowest level aerosol data into an emissions rate. This is
221 !.. very far from ideal, but need higher emissions where larger amount
222 !.. of (climo) existing and lesser emissions where there exists fewer to
223 !.. begin as a first-order simplistic approach. Later, proper connection to
224 !.. emission inventory would be better, but, for now, scale like this:
225 !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit
226 !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3)
227 !+---+-----------------------------------------------------------------+
228 if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.'
229 do i = 1, ncol
230 z1 = hgt(i,2)-hgt(i,1)
231 nwfa2d(i) = nwfa(i,1) * 0.000196 * (50./z1)
232 enddo
233 else
234 if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.'
235 endif
236 endif
237
238 ! Potential ice nuclei (IN)
239 if (maxval(nifa) .lt. eps) then
240 if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosols.'
241 do i = 1, ncol
242 if (hgt(i,1).le.1000.0) then
243 h_01 = 0.8
244 elseif (hgt(i,1).ge.2500.0) then
245 h_01 = 0.01
246 else
247 h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0)
248 endif
249 niin3 = -1.0*alog(nain1/nain0)/h_01
250 nifa(i,1) = nain1+nain0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niin3)
251 nifa2d(i) = 0.
252 do k = 2, nlev
253 nifa(i,k) = nain1+nain0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niin3)
254 enddo
255 enddo
256 else
257 if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosols are present.'
258 if (maxval(nifa2d) .lt. eps) then
259 if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.'
260 ! calculate IN surface flux here, right now just set to zero
261 nifa2d = 0.
262 else
263 if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.'
264 endif
265 endif
266
267 ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number.
268 where(qc .LE. 0.0) nc=0.0
269 where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_dropletnumber(qc*rho, nwfa*rho) * orho
270 where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc = 0.0
271
272 ! Ensure non-negative aerosol number concentrations.
273 where(nwfa .LE. 0.0) nwfa = 1.1e6
274 where(nifa .LE. 0.0) nifa = nain1*0.01
275
276 ! Copy to local array for calculating cloud effective radii below
277 nc_local = nc
278
279 else if (merra2_aerosol_aware) then
280
281 ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number.
282 where(qc .LE. 0.0) nc=0.0
283 where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_dropletnumber(qc*rho, nwfa*rho) * orho
284 where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc = 0.0
285
286 else
287
288 ! Constant droplet concentration for single moment cloud water as in
289 ! module_mp_thompson.F90, only needed for effective radii calculation
290 nc_local = nt_c_l/rho
291
292 end if
293
294 if (convert_dry_rho) then
295 !qc = qc/(1.0_kind_phys+qv)
296 !qr = qr/(1.0_kind_phys+qv)
297 !qi = qi/(1.0_kind_phys+qv)
298 !qs = qs/(1.0_kind_phys+qv)
299 !qg = qg/(1.0_kind_phys+qv)
300
301 ni = ni/(1.0_kind_phys+qv)
302 nr = nr/(1.0_kind_phys+qv)
303 if (is_aerosol_aware .or. merra2_aerosol_aware) then
304 nc = nc/(1.0_kind_phys+qv)
305 nwfa = nwfa/(1.0_kind_phys+qv)
306 nifa = nifa/(1.0_kind_phys+qv)
307 end if
308 end if
309
310 is_initialized = .true.
311
312 end subroutine mp_thompson_init
313
314
321 subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, &
322 con_eps, convert_dry_rho, &
323 spechum, qc, qr, qi, qs, qg, ni, nr, &
324 is_aerosol_aware, &
325 merra2_aerosol_aware, nc, nwfa, nifa,&
326 nwfa2d, nifa2d, aero_ind_fdb, &
327 tgrs, prsl, phii, omega, &
328 sedi_semi, decfl, islmsk, dtp, &
329 dt_inner, &
330 first_time_step, istep, nsteps, &
331 prcp, rain, graupel, ice, snow, sr, &
332 refl_10cm, fullradar_diag, &
333 max_hail_diam_sfc, &
334 do_radar_ref, aerfld, &
335 mpicomm, mpirank, mpiroot, blkno, &
336 ext_diag, diag3d, reset_diag3d, &
337 spp_wts_mp, spp_mp, n_var_spp, &
338 spp_prt_list, spp_var_list, &
339 spp_stddev_cutoff, &
340 cplchm, pfi_lsan, pfl_lsan, &
341 errmsg, errflg)
342
343 implicit none
344
345 ! Interface variables
346
347 ! Dimensions and constants
348 integer, intent(in ) :: ncol
349 integer, intent(in ) :: nlev
350 real(kind_phys), intent(in ) :: con_g
351 real(kind_phys), intent(in ) :: con_rd
352 real(kind_phys), intent(in ) :: con_eps
353 ! Hydrometeors
354 logical, intent(in ) :: convert_dry_rho
355 real(kind_phys), intent(inout) :: spechum(:,:)
356 real(kind_phys), intent(inout) :: qc(:,:)
357 real(kind_phys), intent(inout) :: qr(:,:)
358 real(kind_phys), intent(inout) :: qi(:,:)
359 real(kind_phys), intent(inout) :: qs(:,:)
360 real(kind_phys), intent(inout) :: qg(:,:)
361 real(kind_phys), intent(inout) :: ni(:,:)
362 real(kind_phys), intent(inout) :: nr(:,:)
363 ! Aerosols
364 logical, intent(in) :: is_aerosol_aware, fullradar_diag
365 logical, intent(in) :: merra2_aerosol_aware
366 real(kind_phys), optional, intent(inout) :: nc(:,:)
367 real(kind_phys), optional, intent(inout) :: nwfa(:,:)
368 real(kind_phys), optional, intent(inout) :: nifa(:,:)
369 real(kind_phys), optional, intent(in ) :: nwfa2d(:)
370 real(kind_phys), optional, intent(in ) :: nifa2d(:)
371 real(kind_phys), intent(in) :: aerfld(:,:,:)
372 logical, optional, intent(in ) :: aero_ind_fdb
373 ! State variables and timestep information
374 real(kind_phys), intent(inout) :: tgrs(:,:)
375 real(kind_phys), intent(in ) :: prsl(:,:)
376 real(kind_phys), intent(in ) :: phii(:,:)
377 real(kind_phys), intent(in ) :: omega(:,:)
378 integer, intent(in ) :: islmsk(:)
379 real(kind_phys), intent(in ) :: dtp
380 logical, intent(in ) :: first_time_step
381 integer, intent(in ) :: istep, nsteps
382 real, intent(in ) :: dt_inner
383 ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip
384 real(kind_phys), intent(inout) :: prcp(:)
385 real(kind_phys), intent(inout), optional :: rain(:)
386 real(kind_phys), intent(inout), optional :: graupel(:)
387 real(kind_phys), intent(inout), optional :: ice(:)
388 real(kind_phys), intent(inout), optional :: snow(:)
389 real(kind_phys), intent( out) :: sr(:)
390 ! Radar reflectivity
391 real(kind_phys), intent(inout) :: refl_10cm(:,:)
392 real(kind_phys), intent(inout) :: max_hail_diam_sfc(:)
393 logical, intent(in ) :: do_radar_ref
394 logical, intent(in) :: sedi_semi
395 integer, intent(in) :: decfl
396 ! MPI and block information
397 integer, intent(in) :: blkno
398 type(mpi_comm), intent(in) :: mpicomm
399 integer, intent(in) :: mpirank
400 integer, intent(in) :: mpiroot
401 ! Extended diagnostic output
402 logical, intent(in) :: ext_diag
403 real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:)
404 logical, intent(in) :: reset_diag3d
405
406 ! CCPP error handling
407 character(len=*), intent( out) :: errmsg
408 integer, intent( out) :: errflg
409
410 ! SPP
411 integer, intent(in) :: spp_mp
412 integer, intent(in) :: n_var_spp
413 real(kind_phys), intent(in), optional :: spp_wts_mp(:,:)
414 real(kind_phys), intent(in), optional :: spp_prt_list(:)
415 character(len=10), intent(in), optional :: spp_var_list(:)
416 real(kind_phys), intent(in) :: spp_stddev_cutoff(:)
417
418 logical, intent (in) :: cplchm
419 ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true.
420 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan
421 real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan
422
423 ! Local variables
424
425 ! Reduced time step if subcycling is used
426 real(kind_phys) :: dtstep
427 integer :: ndt
428 ! Air density
429 real(kind_phys) :: rho(1:ncol,1:nlev)
430 ! Water vapor mixing ratio (instead of specific humidity)
431 real(kind_phys) :: qv(1:ncol,1:nlev)
432 ! Vertical velocity and level width
433 real(kind_phys) :: w(1:ncol,1:nlev)
434 real(kind_phys) :: dz(1:ncol,1:nlev)
435 ! Rain/snow/graupel fall amounts
436 real(kind_phys) :: rain_mp(1:ncol) ! mm, dummy, not used
437 real(kind_phys) :: graupel_mp(1:ncol) ! mm, dummy, not used
438 real(kind_phys) :: ice_mp(1:ncol) ! mm, dummy, not used
439 real(kind_phys) :: snow_mp(1:ncol) ! mm, dummy, not used
440 real(kind_phys) :: delta_rain_mp(1:ncol) ! mm
441 real(kind_phys) :: delta_graupel_mp(1:ncol) ! mm
442 real(kind_phys) :: delta_ice_mp(1:ncol) ! mm
443 real(kind_phys) :: delta_snow_mp(1:ncol) ! mm
444
445 real(kind_phys) :: pfils(1:ncol,1:nlev,1)
446 real(kind_phys) :: pflls(1:ncol,1:nlev,1)
447 ! Radar reflectivity
448 logical :: diagflag ! must be true if do_radar_ref is true, not used otherwise
449 integer :: do_radar_ref_mp ! integer instead of logical do_radar_ref
450 ! Effective cloud radii - turned off in CCPP (taken care off in radiation)
451 logical, parameter :: do_effective_radii = .false.
452 integer, parameter :: has_reqc = 0
453 integer, parameter :: has_reqi = 0
454 integer, parameter :: has_reqs = 0
455 integer, parameter :: kme_stoch = 1
456 integer :: spp_mp_opt
457 ! Dimensions used in mp_gt_driver
458 integer :: ids,ide, jds,jde, kds,kde, &
459 ims,ime, jms,jme, kms,kme, &
460 its,ite, jts,jte, kts,kte
461 ! Pointer arrays for extended diagnostics
462 !real(kind_phys), dimension(:,:,:), pointer :: vts1 => null()
463 !real(kind_phys), dimension(:,:,:), pointer :: txri => null()
464 !real(kind_phys), dimension(:,:,:), pointer :: txrc => null()
465 real(kind_phys), dimension(:,:,:), pointer :: prw_vcdc => null()
466 real(kind_phys), dimension(:,:,:), pointer :: prw_vcde => null()
467 real(kind_phys), dimension(:,:,:), pointer :: tpri_inu => null()
468 real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_d => null()
469 real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_s => null()
470 real(kind_phys), dimension(:,:,:), pointer :: tprs_ide => null()
471 real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_d => null()
472 real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_s => null()
473 real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_d => null()
474 real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_s => null()
475 real(kind_phys), dimension(:,:,:), pointer :: tpri_iha => null()
476 real(kind_phys), dimension(:,:,:), pointer :: tpri_wfz => null()
477 real(kind_phys), dimension(:,:,:), pointer :: tpri_rfz => null()
478 real(kind_phys), dimension(:,:,:), pointer :: tprg_rfz => null()
479 real(kind_phys), dimension(:,:,:), pointer :: tprs_scw => null()
480 real(kind_phys), dimension(:,:,:), pointer :: tprg_scw => null()
481 real(kind_phys), dimension(:,:,:), pointer :: tprg_rcs => null()
482 real(kind_phys), dimension(:,:,:), pointer :: tprs_rcs => null()
483 real(kind_phys), dimension(:,:,:), pointer :: tprr_rci => null()
484 real(kind_phys), dimension(:,:,:), pointer :: tprg_rcg => null()
485 real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_c => null()
486 real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_e => null()
487 real(kind_phys), dimension(:,:,:), pointer :: tprr_sml => null()
488 real(kind_phys), dimension(:,:,:), pointer :: tprr_gml => null()
489 real(kind_phys), dimension(:,:,:), pointer :: tprr_rcg => null()
490 real(kind_phys), dimension(:,:,:), pointer :: tprr_rcs => null()
491 real(kind_phys), dimension(:,:,:), pointer :: tprv_rev => null()
492 real(kind_phys), dimension(:,:,:), pointer :: tten3 => null()
493 real(kind_phys), dimension(:,:,:), pointer :: qvten3 => null()
494 real(kind_phys), dimension(:,:,:), pointer :: qrten3 => null()
495 real(kind_phys), dimension(:,:,:), pointer :: qsten3 => null()
496 real(kind_phys), dimension(:,:,:), pointer :: qgten3 => null()
497 real(kind_phys), dimension(:,:,:), pointer :: qiten3 => null()
498 real(kind_phys), dimension(:,:,:), pointer :: niten3 => null()
499 real(kind_phys), dimension(:,:,:), pointer :: nrten3 => null()
500 real(kind_phys), dimension(:,:,:), pointer :: ncten3 => null()
501 real(kind_phys), dimension(:,:,:), pointer :: qcten3 => null()
502
503 ! Initialize the CCPP error handling variables
504 errmsg = ''
505 errflg = 0
506
507 if (first_time_step .and. istep==1 .and. blkno==1) then
508 ! Check initialization state
509 if (.not.is_initialized) then
510 write(errmsg, fmt='((a))') 'mp_thompson_run called before mp_thompson_init'
511 errflg = 1
512 return
513 end if
514 ! Check forr optional arguments of aerosol-aware microphysics
515 if (is_aerosol_aware .and. .not. (present(nc) .and. &
516 present(nwfa) .and. &
517 present(nifa) .and. &
518 present(nwfa2d) .and. &
519 present(nifa2d) )) then
520 write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', &
521 ' aerosol-aware microphysics require all of the', &
522 ' following optional arguments:', &
523 ' nc, nwfa, nifa, nwfa2d, nifa2d'
524 errflg = 1
525 return
526 else if (merra2_aerosol_aware .and. .not. (present(nc) .and. &
527 present(nwfa) .and. &
528 present(nifa) )) then
529 write(errmsg,fmt='(*(a))') 'Logic error in mp_thompson_run:', &
530 ' merra2 aerosol-aware microphysics require the', &
531 ' following optional arguments: nc, nwfa, nifa'
532 errflg = 1
533 return
534 end if
535 ! Consistency cheecks - subcycling and inner loop at the same time are not supported
536 if (nsteps>1 .and. dt_inner < dtp) then
537 write(errmsg,'(*(a))') "Logic error: Subcycling and inner loop cannot be used at the same time"
538 errflg = 1
539 return
540 else if (mpirank==mpiroot .and. nsteps>1) then
541 write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', nsteps, ' substep(s) per time step with an ', &
542 'effective time step of ', dtp/real(nsteps, kind=kind_phys), ' seconds'
543 else if (mpirank==mpiroot .and. dt_inner < dtp) then
544 ndt = max(nint(dtp/dt_inner),1)
545 write(*,'(a,i0,a,a,f6.2,a)') 'Thompson MP is using ', ndt, ' inner loops per time step with an ', &
546 'effective time step of ', dtp/real(ndt, kind=kind_phys), ' seconds'
547 end if
548 end if
549
550 ! Set stochastic physics selection to apply all perturbations
551 if ( spp_mp==7 ) then
552 spp_mp_opt=7
553 else
554 spp_mp_opt=0
555 endif
556
557 ! Set reduced time step if subcycling is used
558 if (nsteps>1) then
559 dtstep = dtp/real(nsteps, kind=kind_phys)
560 else
561 dtstep = dtp
562 end if
563 if (merra2_aerosol_aware) then
564 call get_niwfa(aerfld, nifa, nwfa, ncol, nlev)
565 end if
566
570
571 ! DH* - do this only if istep == 1? Would be ok if it was
572 ! guaranteed that nothing else in the same subcycle group
573 ! was using these arrays, but it is somewhat dangerous.
574 qv = spechum/(1.0_kind_phys-spechum)
575
576 if (convert_dry_rho) then
577 qc = qc/(1.0_kind_phys-spechum)
578 qr = qr/(1.0_kind_phys-spechum)
579 qi = qi/(1.0_kind_phys-spechum)
580 qs = qs/(1.0_kind_phys-spechum)
581 qg = qg/(1.0_kind_phys-spechum)
582
583 ni = ni/(1.0_kind_phys-spechum)
584 nr = nr/(1.0_kind_phys-spechum)
585 if (is_aerosol_aware .or. merra2_aerosol_aware) then
586 nc = nc/(1.0_kind_phys-spechum)
587 nwfa = nwfa/(1.0_kind_phys-spechum)
588 nifa = nifa/(1.0_kind_phys-spechum)
589 end if
590 end if
591 ! *DH
592
594 rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps))
595
597 w = -omega/(rho*con_g)
598
600 dz = (phii(:,2:nlev+1) - phii(:,1:nlev)) / con_g
601
602 ! Accumulated values inside Thompson scheme, not used;
603 ! only use delta and add to inout variables (different units)
604 rain_mp = 0
605 graupel_mp = 0
606 ice_mp = 0
607 snow_mp = 0
608 delta_rain_mp = 0
609 delta_graupel_mp = 0
610 delta_ice_mp = 0
611 delta_snow_mp = 0
612
613 ! Flags for calculating radar reflectivity; diagflag is redundant
614 if (do_radar_ref) then
615 diagflag = .true.
616 do_radar_ref_mp = 1
617 else
618 diagflag = .false.
619 do_radar_ref_mp = 0
620 end if
621
622 ! Set internal dimensions
623 ids = 1
624 ims = 1
625 its = 1
626 ide = ncol
627 ime = ncol
628 ite = ncol
629 jds = 1
630 jms = 1
631 jts = 1
632 jde = 1
633 jme = 1
634 jte = 1
635 kds = 1
636 kms = 1
637 kts = 1
638 kde = nlev
639 kme = nlev
640 kte = nlev
641 if(cplchm) then
642 pfi_lsan = 0.0
643 pfl_lsan = 0.0
644 end if
645
646 ! Set pointers for extended diagnostics
647 set_extended_diagnostic_pointers: if (ext_diag) then
648 if (reset_diag3d) then
649 diag3d = 0.0
650 end if
651 !vts1 => diag3d(:,:,X:X)
652 !txri => diag3d(:,:,X:X)
653 !txrc => diag3d(:,:,X:X)
654 prw_vcdc => diag3d(:,:,1:1)
655 prw_vcde => diag3d(:,:,2:2)
656 tpri_inu => diag3d(:,:,3:3)
657 tpri_ide_d => diag3d(:,:,4:4)
658 tpri_ide_s => diag3d(:,:,5:5)
659 tprs_ide => diag3d(:,:,6:6)
660 tprs_sde_d => diag3d(:,:,7:7)
661 tprs_sde_s => diag3d(:,:,8:8)
662 tprg_gde_d => diag3d(:,:,9:9)
663 tprg_gde_s => diag3d(:,:,10:10)
664 tpri_iha => diag3d(:,:,11:11)
665 tpri_wfz => diag3d(:,:,12:12)
666 tpri_rfz => diag3d(:,:,13:13)
667 tprg_rfz => diag3d(:,:,14:14)
668 tprs_scw => diag3d(:,:,15:15)
669 tprg_scw => diag3d(:,:,16:16)
670 tprg_rcs => diag3d(:,:,17:17)
671 tprs_rcs => diag3d(:,:,18:18)
672 tprr_rci => diag3d(:,:,19:19)
673 tprg_rcg => diag3d(:,:,20:20)
674 tprw_vcd_c => diag3d(:,:,21:21)
675 tprw_vcd_e => diag3d(:,:,22:22)
676 tprr_sml => diag3d(:,:,23:23)
677 tprr_gml => diag3d(:,:,24:24)
678 tprr_rcg => diag3d(:,:,25:25)
679 tprr_rcs => diag3d(:,:,26:26)
680 tprv_rev => diag3d(:,:,27:27)
681 tten3 => diag3d(:,:,28:28)
682 qvten3 => diag3d(:,:,29:29)
683 qrten3 => diag3d(:,:,30:30)
684 qsten3 => diag3d(:,:,31:31)
685 qgten3 => diag3d(:,:,32:32)
686 qiten3 => diag3d(:,:,33:33)
687 niten3 => diag3d(:,:,34:34)
688 nrten3 => diag3d(:,:,35:35)
689 ncten3 => diag3d(:,:,36:36)
690 qcten3 => diag3d(:,:,37:37)
691 end if set_extended_diagnostic_pointers
693 if (is_aerosol_aware) then
694 call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, &
695 nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, &
696 tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, &
697 sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, &
698 rainnc=rain_mp, rainncv=delta_rain_mp, &
699 snownc=snow_mp, snowncv=delta_snow_mp, &
700 icenc=ice_mp, icencv=delta_ice_mp, &
701 graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, &
702 refl_10cm=refl_10cm, &
703 diagflag=diagflag, do_radar_ref=do_radar_ref_mp, &
704 max_hail_diam_sfc=max_hail_diam_sfc, &
705 has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, &
706 aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, &
707 kme_stoch=kme_stoch, &
708 rand_pert=spp_wts_mp, spp_var_list=spp_var_list, &
709 spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, &
710 spp_stddev_cutoff=spp_stddev_cutoff, &
711 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
712 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
713 its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
714 fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, &
715 first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, &
716 ! Extended diagnostics
717 ext_diag=ext_diag, &
718 ! vts1=vts1, txri=txri, txrc=txrc, &
719 prw_vcdc=prw_vcdc, &
720 prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, &
721 tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, &
722 tprs_sde_d=tprs_sde_d, &
723 tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, &
724 tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, &
725 tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, &
726 tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, &
727 tprs_rcs=tprs_rcs, &
728 tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, &
729 tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, &
730 tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, &
731 tprv_rev=tprv_rev, tten3=tten3, &
732 qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, &
733 qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, &
734 qcten3=qcten3, pfils=pfils, pflls=pflls)
735 else if (merra2_aerosol_aware) then
736 call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, &
737 nc=nc, nwfa=nwfa, nifa=nifa, &
738 tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, &
739 sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, &
740 rainnc=rain_mp, rainncv=delta_rain_mp, &
741 snownc=snow_mp, snowncv=delta_snow_mp, &
742 icenc=ice_mp, icencv=delta_ice_mp, &
743 graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, &
744 refl_10cm=refl_10cm, &
745 diagflag=diagflag, do_radar_ref=do_radar_ref_mp, &
746 max_hail_diam_sfc=max_hail_diam_sfc, &
747 has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, &
748 aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, &
749 kme_stoch=kme_stoch, &
750 rand_pert=spp_wts_mp, spp_var_list=spp_var_list, &
751 spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, &
752 spp_stddev_cutoff=spp_stddev_cutoff, &
753 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
754 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
755 its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
756 fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, &
757 first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, &
758 ! Extended diagnostics
759 ext_diag=ext_diag, &
760 ! vts1=vts1, txri=txri, txrc=txrc, &
761 prw_vcdc=prw_vcdc, &
762 prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, &
763 tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, &
764 tprs_sde_d=tprs_sde_d, &
765 tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, &
766 tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, &
767 tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, &
768 tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, &
769 tprs_rcs=tprs_rcs, &
770 tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, &
771 tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, &
772 tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, &
773 tprv_rev=tprv_rev, tten3=tten3, &
774 qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, &
775 qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, &
776 qcten3=qcten3, pfils=pfils, pflls=pflls)
777 else
778 call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, &
779 tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, &
780 sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, &
781 rainnc=rain_mp, rainncv=delta_rain_mp, &
782 snownc=snow_mp, snowncv=delta_snow_mp, &
783 icenc=ice_mp, icencv=delta_ice_mp, &
784 graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, &
785 refl_10cm=refl_10cm, &
786 diagflag=diagflag, do_radar_ref=do_radar_ref_mp, &
787 max_hail_diam_sfc=max_hail_diam_sfc, &
788 has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, &
789 rand_perturb_on=spp_mp_opt, kme_stoch=kme_stoch, &
790 rand_pert=spp_wts_mp, spp_var_list=spp_var_list, &
791 spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, &
792 spp_stddev_cutoff=spp_stddev_cutoff, &
793 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
794 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
795 its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
796 fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, &
797 first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, &
798 ! Extended diagnostics
799 ext_diag=ext_diag, &
800 ! vts1=vts1, txri=txri, txrc=txrc, &
801 prw_vcdc=prw_vcdc, &
802 prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, &
803 tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, &
804 tprs_sde_d=tprs_sde_d, &
805 tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, &
806 tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, &
807 tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, &
808 tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, &
809 tprs_rcs=tprs_rcs, &
810 tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, &
811 tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, &
812 tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, &
813 tprv_rev=tprv_rev, tten3=tten3, &
814 qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, &
815 qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, &
816 qcten3=qcten3, pfils=pfils, pflls=pflls)
817 end if
818 if (errflg/=0) return
819
820 ! DH* - do this only if istep == nsteps? Would be ok if it was
821 ! guaranteed that nothing else in the same subcycle group
822 ! was using these arrays, but it is somewhat dangerous.
823
825 spechum = qv/(1.0_kind_phys+qv)
826
827 if (convert_dry_rho) then
828 qc = qc/(1.0_kind_phys+qv)
829 qr = qr/(1.0_kind_phys+qv)
830 qi = qi/(1.0_kind_phys+qv)
831 qs = qs/(1.0_kind_phys+qv)
832 qg = qg/(1.0_kind_phys+qv)
833
834 ni = ni/(1.0_kind_phys+qv)
835 nr = nr/(1.0_kind_phys+qv)
836 if (is_aerosol_aware .or. merra2_aerosol_aware) then
837 nc = nc/(1.0_kind_phys+qv)
838 nwfa = nwfa/(1.0_kind_phys+qv)
839 nifa = nifa/(1.0_kind_phys+qv)
840 end if
841 end if
842 ! *DH
843
845 ! "rain" in Thompson MP refers to precipitation (total of liquid rainfall+snow+graupel+ice)
846 prcp = prcp + max(0.0, delta_rain_mp/1000.0_kind_phys)
847 graupel = graupel + max(0.0, delta_graupel_mp/1000.0_kind_phys)
848 ice = ice + max(0.0, delta_ice_mp/1000.0_kind_phys)
849 snow = snow + max(0.0, delta_snow_mp/1000.0_kind_phys)
850 rain = rain + max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys)
851
852 ! Recompute sr at last subcycling step
853 if (nsteps>1 .and. istep == nsteps) then
854 ! Unlike inside mp_gt_driver, rain does not contain frozen precip
855 sr = (snow + graupel + ice)/(rain + snow + graupel + ice +1.e-12)
856 end if
857
858 ! output instantaneous ice/snow and rain water 3d precipitation fluxes
859 if(cplchm) then
860 pfi_lsan(:,:) = pfils(:,:,1)
861 pfl_lsan(:,:) = pflls(:,:,1)
862 end if
863
864 ! DH* Not really needed because they go out of scope ...
865 ! But having them in here seems to cause problems with Intel?
866 ! It looked like this is also nullifying the pointers passed
867 ! from the CCPP caps.
868 !unset_extended_diagnostic_pointers: if (ext_diag) then
869 ! !vts1 => null()
870 ! !txri => null()
871 ! !txrc => null()
872 ! prw_vcdc => null()
873 ! prw_vcde => null()
874 ! tpri_inu => null()
875 ! tpri_ide_d => null()
876 ! tpri_ide_s => null()
877 ! tprs_ide => null()
878 ! tprs_sde_d => null()
879 ! tprs_sde_s => null()
880 ! tprg_gde_d => null()
881 ! tprg_gde_s => null()
882 ! tpri_iha => null()
883 ! tpri_wfz => null()
884 ! tpri_rfz => null()
885 ! tprg_rfz => null()
886 ! tprs_scw => null()
887 ! tprg_scw => null()
888 ! tprg_rcs => null()
889 ! tprs_rcs => null()
890 ! tprr_rci => null()
891 ! tprg_rcg => null()
892 ! tprw_vcd_c => null()
893 ! tprw_vcd_e => null()
894 ! tprr_sml => null()
895 ! tprr_gml => null()
896 ! tprr_rcg => null()
897 ! tprr_rcs => null()
898 ! tprv_rev => null()
899 ! tten3 => null()
900 ! qvten3 => null()
901 ! qrten3 => null()
902 ! qsten3 => null()
903 ! qgten3 => null()
904 ! qiten3 => null()
905 ! niten3 => null()
906 ! nrten3 => null()
907 ! ncten3 => null()
908 ! qcten3 => null()
909 !end if unset_extended_diagnostic_pointers
910 ! *DH
911
912 end subroutine mp_thompson_run
914
918 subroutine mp_thompson_finalize(errmsg, errflg)
919
920 implicit none
921
922 character(len=*), intent( out) :: errmsg
923 integer, intent( out) :: errflg
924
925 ! Initialize the CCPP error handling variables
926 errmsg = ''
927 errflg = 0
928
929 if (.not.is_initialized) return
930
931 call thompson_finalize()
932
933 is_initialized = .false.
934
935 end subroutine mp_thompson_finalize
936
937 subroutine get_niwfa(aerfld, nifa, nwfa, ncol, nlev)
938 ! To calculate nifa and nwfa from bins of aerosols.
939 ! In GOCART and MERRA2, aerosols are given as mixing ratio (kg/kg). To
940 ! convert from kg/kg to #/kg, the "unit mass" (mass of one particle)
941 ! within the mass bins is calculated. A lognormal size distribution
942 ! within aerosol bins is used to find the size based upon the median
943 ! mass. NIFA is mainly summarized over five dust bins and NWFA over the
944 ! other 10 bins. The parameters besides each bins are carefully tuned
945 ! for a good performance of the scheme.
946 !
947 ! The fields for the last index of the aerfld array
948 ! are specified as below.
949 ! 1: dust bin 1, 0.1 to 1.0 micrometers
950 ! 2: dust bin 2, 1.0 to 1.8 micrometers
951 ! 3: dust bin 3, 1.8 to 3.0 micrometers
952 ! 4: dust bin 4, 3.0 to 6.0 micrometers
953 ! 5: dust bin 5, 6.0 to 10.0 micrometers
954 ! 6: sea salt bin 1, 0.03 to 0.1 micrometers
955 ! 7: sea salt bin 2, 0.1 to 0.5 micrometers
956 ! 8: sea salt bin 3, 0.5 to 1.5 micrometers
957 ! 9: sea salt bin 4, 1.5 to 5.0 micrometers
958 ! 10: sea salt bin 5, 5.0 to 10.0 micrometers
959 ! 11: Sulfate, 0.35 (mean) micrometers
960 ! 15: water-friendly organic carbon, 0.35 (mean) micrometers
961 !
962 ! Bin densities are as follows:
963 ! 1: dust bin 1: 2500 kg/m2
964 ! 2-5: dust bin 2-5: 2650 kg/m2
965 ! 6-10: sea salt bins 6-10: 2200 kg/m2
966 ! 11: sulfate: 1700 kg/m2
967 ! 15: organic carbon: 1800 kg/m2
968
969 implicit none
970 integer, intent(in)::ncol, nlev
971 real (kind=kind_phys), dimension(:,:,:), intent(in) :: aerfld
972 real (kind=kind_phys), dimension(:,:), intent(out ):: nifa, nwfa
973
974 nifa=(aerfld(:,:,1)/4.0737762+aerfld(:,:,2)/30.459203+aerfld(:,:,3)/153.45048+ &
975 aerfld(:,:,4)/1011.5142+ aerfld(:,:,5)/5683.3501)*1.e15
976
977 nwfa=((aerfld(:,:,6)/0.0045435214+aerfld(:,:,7)/0.2907854+aerfld(:,:,8)/12.91224+ &
978 aerfld(:,:,9)/206.2216+ aerfld(:,:,10)/4326.23)*9.+aerfld(:,:,11)/0.3053104*5+ &
979 aerfld(:,:,15)/0.3232698*8)*1.e15
980 end subroutine get_niwfa
981
982end module mp_thompson
subroutine thompson_init(is_aerosol_aware_in, merra2_aerosol_aware_in, mpicomm, mpirank, mpiroot, threads, errmsg, errflg)
This subroutine calculates simplified cloud species equations and create lookup tables in Thomspson s...
subroutine mp_gt_driver(wrf_chem)
This is a wrapper routine designed to transfer values from 3D to 1D.
subroutine, public mp_thompson_run(ncol, nlev, con_g, con_rd, con_eps, convert_dry_rho, spechum, qc, qr, qi, qs, qg, ni, nr, is_aerosol_aware, merra2_aerosol_aware, nc, nwfa, nifa, nwfa2d, nifa2d, aero_ind_fdb, tgrs, prsl, phii, omega, sedi_semi, decfl, islmsk, dtp, dt_inner, first_time_step, istep, nsteps, prcp, rain, graupel, ice, snow, sr, refl_10cm, fullradar_diag, max_hail_diam_sfc, do_radar_ref, aerfld, mpicomm, mpirank, mpiroot, blkno, ext_diag, diag3d, reset_diag3d, spp_wts_mp, spp_mp, n_var_spp, spp_prt_list, spp_var_list, spp_stddev_cutoff, cplchm, pfi_lsan, pfl_lsan, errmsg, errflg)
subroutine calc_effectrad(t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, re_qc1d, re_qi1d, re_qs1d, lsml, kts, kte)
Compute radiation effective radii of cloud water, ice, and snow. These are entirely consistent with m...
elemental real function, public make_icenumber(q_ice, temp)
Table of lookup values of radiative effective radius of ice crystals as a function of Temperature fro...