Line data Source code
1 : module carma_aerosol_properties_mod
2 : use shr_kind_mod, only: r8 => shr_kind_r8
3 : use physconst, only: pi
4 : use aerosol_properties_mod, only: aerosol_properties, aero_name_len
5 : use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_bin_props_by_idx, &
6 : rad_cnst_get_info_by_bin, rad_cnst_get_info_by_bin_spec, rad_cnst_get_bin_props
7 : use infnan, only: nan, assignment(=)
8 :
9 : implicit none
10 :
11 : private
12 :
13 : public :: carma_aerosol_properties
14 :
15 : type, extends(aerosol_properties) :: carma_aerosol_properties
16 : private
17 : integer, allocatable :: ibl(:)
18 : contains
19 : procedure :: number_transported
20 : procedure :: get
21 : procedure :: amcube
22 : procedure :: actfracs
23 : procedure :: num_names
24 : procedure :: mmr_names
25 : procedure :: amb_num_name
26 : procedure :: amb_mmr_name
27 : procedure :: species_type
28 : procedure :: icenuc_updates_num
29 : procedure :: icenuc_updates_mmr
30 : procedure :: apply_number_limits
31 : procedure :: hetfrz_species
32 : procedure :: optics_params
33 : procedure :: nbins_rlist
34 : procedure :: nspecies_per_bin_rlist
35 : procedure :: alogsig_rlist
36 : procedure :: soluble
37 : procedure :: min_mass_mean_rad
38 : procedure :: bin_name
39 : procedure :: scav_diam
40 : procedure :: resuspension_resize
41 : procedure :: rebin_bulk_fluxes
42 : procedure :: hydrophilic
43 :
44 : final :: destructor
45 : end type carma_aerosol_properties
46 :
47 : interface carma_aerosol_properties
48 : procedure :: constructor
49 : end interface carma_aerosol_properties
50 :
51 : real(r8), parameter :: onethird = 1._r8/3._r8
52 :
53 : contains
54 :
55 : !------------------------------------------------------------------------------
56 : !------------------------------------------------------------------------------
57 6144 : function constructor() result(newobj)
58 :
59 : type(carma_aerosol_properties), pointer :: newobj
60 :
61 : integer :: l, m, nbins, ncnst_tot
62 6144 : integer,allocatable :: nspecies(:)
63 6144 : integer,allocatable :: nmasses(:)
64 6144 : real(r8),allocatable :: alogsig(:)
65 6144 : real(r8),allocatable :: f1(:)
66 6144 : real(r8),allocatable :: f2(:)
67 : integer :: ierr
68 :
69 6144 : integer, pointer :: ibl(:)
70 : integer :: ii, imx, imx_num, imx_mmr, ipr, ipr_num, ipr_mmr
71 : character(len=32) :: spectype
72 : character(len=32) :: bin_name
73 : character(len=32) :: bin_name_l ! bin name of the larger bin
74 :
75 6144 : integer, allocatable :: imx_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin
76 6144 : integer, allocatable :: imx_mmr_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for mmr
77 6144 : integer, allocatable :: imx_num_bl(:) ! index used to map pure sulfate bin to mixed sulfate bin for num
78 :
79 6144 : allocate(newobj,stat=ierr)
80 6144 : if( ierr /= 0 ) then
81 6144 : nullify(newobj)
82 : return
83 : end if
84 :
85 6144 : call rad_cnst_get_info( 0, nbins=nbins)
86 :
87 18432 : allocate( nspecies(nbins),stat=ierr )
88 6144 : if( ierr /= 0 ) then
89 6144 : nullify(newobj)
90 : return
91 : end if
92 12288 : allocate( nmasses(nbins),stat=ierr )
93 6144 : if( ierr /= 0 ) then
94 6144 : nullify(newobj)
95 : return
96 : end if
97 18432 : allocate( alogsig(nbins),stat=ierr )
98 6144 : if( ierr /= 0 ) then
99 6144 : nullify(newobj)
100 : return
101 : end if
102 12288 : allocate( f1(nbins),stat=ierr )
103 6144 : if( ierr /= 0 ) then
104 6144 : nullify(newobj)
105 : return
106 : end if
107 12288 : allocate( f2(nbins),stat=ierr )
108 6144 : if( ierr /= 0 ) then
109 6144 : nullify(newobj)
110 : return
111 : end if
112 :
113 6144 : ncnst_tot = 0
114 :
115 251904 : do m = 1, nbins
116 245760 : call rad_cnst_get_info_by_bin(0, m, nspec=nspecies(m))
117 245760 : ncnst_tot = ncnst_tot + nspecies(m) + 1
118 251904 : nmasses(m) = nspecies(m)
119 : end do
120 :
121 251904 : alogsig(:) = log(2._r8)
122 251904 : f1 = 1._r8
123 251904 : f2 = 1._r8
124 :
125 6144 : call newobj%initialize(nbins,ncnst_tot,nspecies,nmasses,alogsig,f1,f2,ierr)
126 6144 : if( ierr /= 0 ) then
127 6144 : nullify(newobj)
128 : return
129 : end if
130 6144 : deallocate(nspecies)
131 6144 : deallocate(nmasses)
132 6144 : deallocate(alogsig)
133 6144 : deallocate(f1)
134 6144 : deallocate(f2)
135 :
136 18432 : allocate(newobj%ibl(ncnst_tot),stat=ierr)
137 6144 : if( ierr /= 0 ) then
138 6144 : nullify(newobj)
139 : return
140 : end if
141 6144 : ibl => newobj%ibl
142 :
143 1603584 : ibl = -1
144 :
145 18432 : allocate(imx_num_bl(nbins),stat=ierr)
146 6144 : if( ierr /= 0 ) then
147 6144 : nullify(newobj)
148 : return
149 : end if
150 12288 : allocate(imx_mmr_bl(nbins),stat=ierr)
151 6144 : if( ierr /= 0 ) then
152 6144 : nullify(newobj)
153 : return
154 : end if
155 12288 : allocate(imx_bl(nbins),stat=ierr)
156 6144 : if( ierr /= 0 ) then
157 6144 : nullify(newobj)
158 : return
159 : end if
160 :
161 6144 : imx = 0
162 6144 : imx_mmr = 0
163 6144 : imx_num = 0
164 6144 : ipr = 0
165 6144 : ipr_mmr = 0
166 6144 : ipr_num = 0
167 :
168 251904 : do m = 1,nbins
169 245760 : bin_name = newobj%bin_name(0,m)
170 245760 : bin_name_l = ' '
171 245760 : if (m<nbins) then
172 239616 : bin_name_l = newobj%bin_name(0,m+1)
173 : end if
174 :
175 1849344 : do l = 0,newobj%nspecies(m)
176 1597440 : ii = newobj%indexer(m,l)
177 1597440 : ibl(ii) = ii
178 :
179 : ! derive index array for larger bin, for evaporation into larger bi
180 1597440 : if (l>0 .and. l<=newobj%nspecies(m)) then
181 1351680 : call newobj%species_type(m,l,spectype)
182 : else
183 245760 : spectype = 'other'
184 : end if
185 :
186 : ! identification is required for pure and mixed aerosols, mixed aeroosols are moved to
187 : ! larger bin, pure aerosols are moved to mixed sulfate
188 :
189 1597440 : if (index(bin_name,'MXAER')>0 .and. index(bin_name_l,'MXAER')>0) then
190 : ! for mixed aerosols
191 : ! find larger bin
192 1284096 : ibl(ii) = newobj%indexer(m+1,l)
193 : ! define mixed aerosol sulfate index to be used for pure sulfate only
194 1284096 : if (trim(spectype) == 'sulfate') then
195 116736 : imx = imx + 1
196 116736 : imx_bl(imx) = ibl(ii)
197 : end if
198 1284096 : if (l == newobj%nspecies(m)+1) then ! only for mmr
199 0 : imx_mmr = imx_mmr + 1
200 0 : ibl(ii) = newobj%indexer(m+1,l)
201 0 : imx_mmr_bl(imx_mmr) = ibl(ii)
202 : end if
203 1284096 : if (l == 0) then ! only for num
204 116736 : imx_num = imx_num + 1
205 116736 : ibl(ii) = newobj%indexer(m+1,l)
206 116736 : imx_num_bl(imx_num) = ibl(ii)
207 : end if
208 : end if ! MXAER
209 :
210 1597440 : if (index(bin_name,'PRSUL')>0 .and. index(bin_name_l,'PRSUL')>0) then
211 : ! pure sulfate bins
212 233472 : if (trim(spectype) == 'sulfate') then
213 116736 : ipr = ipr +1
214 116736 : ibl(ii) = imx_bl(ipr)
215 : end if
216 233472 : if (l == newobj%nspecies(m)+1) then ! only for mmr reset counter to only go from 1-20 bins
217 0 : ipr_mmr = ipr_mmr + 1
218 0 : ibl(ii) = imx_mmr_bl(ipr_mmr)
219 : end if
220 233472 : if (l == 0 ) then ! only for num reset counter to only go from 1-20 bins
221 116736 : ipr_num = ipr_num + 1
222 116736 : ibl(ii) = imx_num_bl(ipr_num)
223 : end if
224 : end if
225 1843200 : if (ibl(ii).eq.0) then
226 0 : ibl(ii) = ii
227 : end if
228 : end do
229 : end do
230 :
231 6144 : deallocate(imx_mmr_bl, imx_num_bl, imx_bl)
232 :
233 12288 : end function constructor
234 :
235 : !------------------------------------------------------------------------------
236 : !------------------------------------------------------------------------------
237 1536 : subroutine destructor(self)
238 : type(carma_aerosol_properties), intent(inout) :: self
239 :
240 1536 : call self%final()
241 :
242 1536 : end subroutine destructor
243 :
244 : !------------------------------------------------------------------------------
245 : ! returns number of transported aerosol constituents
246 : !------------------------------------------------------------------------------
247 1536 : integer function number_transported(self)
248 : class(carma_aerosol_properties), intent(in) :: self
249 : ! to be implemented later
250 1536 : number_transported = -1
251 1536 : end function number_transported
252 :
253 : !------------------------------------------------------------------------
254 : ! returns aerosol properties:
255 : ! density
256 : ! hygroscopicity
257 : ! species type
258 : ! species name
259 : ! short wave species refractive indices
260 : ! long wave species refractive indices
261 : ! species morphology
262 : !------------------------------------------------------------------------
263 9682066560 : subroutine get(self, bin_ndx, species_ndx, list_ndx, density, hygro, &
264 : spectype, specname, specmorph, refindex_sw, refindex_lw)
265 :
266 : class(carma_aerosol_properties), intent(in) :: self
267 : integer, intent(in) :: bin_ndx ! bin index
268 : integer, intent(in) :: species_ndx ! species index
269 : integer, optional, intent(in) :: list_ndx ! climate or a diagnostic list number
270 : real(r8), optional, intent(out) :: density ! density (kg/m3)
271 : real(r8), optional, intent(out) :: hygro ! hygroscopicity
272 : character(len=*), optional, intent(out) :: spectype ! species type
273 : character(len=*), optional, intent(out) :: specname ! species name
274 : character(len=*), optional, intent(out) :: specmorph ! species morphology
275 : complex(r8), pointer, optional, intent(out) :: refindex_sw(:) ! short wave species refractive indices
276 : complex(r8), pointer, optional, intent(out) :: refindex_lw(:) ! long wave species refractive indices
277 :
278 : integer :: ilist
279 :
280 9682066560 : if (present(list_ndx)) then
281 3908198400 : ilist = list_ndx
282 : else
283 5773868160 : ilist = 0
284 : end if
285 :
286 9682066560 : if (present(density)) then
287 9170117760 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, density_aer=density)
288 : end if
289 9682066560 : if (present(hygro)) then
290 8753023620 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, hygro_aer=hygro)
291 : end if
292 9682066560 : if (present(spectype)) then
293 9024864900 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, spectype=spectype)
294 : end if
295 9682066560 : if (present(refindex_sw)) then
296 3892838400 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, refindex_aer_sw=refindex_sw)
297 : end if
298 9682066560 : if (present(refindex_lw)) then
299 0 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, refindex_aer_lw=refindex_lw)
300 : end if
301 9682066560 : if (present(specmorph)) then
302 15360000 : call rad_cnst_get_bin_props_by_idx(ilist, bin_ndx, species_ndx, specmorph=specmorph)
303 : end if
304 9682066560 : if (present(specname)) then
305 256481280 : if (species_ndx>self%nspecies(bin_ndx)) then
306 0 : call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=specname)
307 : else
308 256481280 : call rad_cnst_get_info_by_bin_spec(ilist, bin_ndx, species_ndx, spec_name=specname)
309 : end if
310 : end if
311 :
312 9682066560 : end subroutine get
313 :
314 : !------------------------------------------------------------------------
315 : ! returns optics type and table parameters
316 : !------------------------------------------------------------------------
317 9216000 : subroutine optics_params(self, list_ndx, bin_ndx, opticstype, extpsw, abspsw, asmpsw, absplw, &
318 : refrtabsw, refitabsw, refrtablw, refitablw, ncoef, prefr, prefi, sw_hygro_ext_wtp, &
319 : sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, wgtpct, nwtp, &
320 : sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, &
321 : corefrac, bcdust, kap, relh, nfrac, nbcdust, nkap, nrelh )
322 :
323 : class(carma_aerosol_properties), intent(in) :: self
324 : integer, intent(in) :: bin_ndx ! bin index
325 : integer, intent(in) :: list_ndx ! rad climate/diags list
326 :
327 : character(len=*), optional, intent(out) :: opticstype
328 :
329 : ! refactive index table parameters
330 : real(r8), optional, pointer :: extpsw(:,:,:,:) ! short wave specific extinction
331 : real(r8), optional, pointer :: abspsw(:,:,:,:) ! short wave specific absorption
332 : real(r8), optional, pointer :: asmpsw(:,:,:,:) ! short wave asymmetry factor
333 : real(r8), optional, pointer :: absplw(:,:,:,:) ! long wave specific absorption
334 : real(r8), optional, pointer :: refrtabsw(:,:) ! table of short wave real refractive indices for aerosols
335 : real(r8), optional, pointer :: refitabsw(:,:) ! table of short wave imaginary refractive indices for aerosols
336 : real(r8), optional, pointer :: refrtablw(:,:) ! table of long wave real refractive indices for aerosols
337 : real(r8), optional, pointer :: refitablw(:,:) ! table of long wave imaginary refractive indices for aerosols
338 : integer, optional, intent(out) :: ncoef ! number of chebychev polynomials
339 : integer, optional, intent(out) :: prefr ! number of real refractive indices in table
340 : integer, optional, intent(out) :: prefi ! number of imaginary refractive indices in table
341 :
342 : ! hygrowghtpct table parameters
343 : real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:) ! short wave extinction table
344 : real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:) ! short wave single-scatter albedo table
345 : real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:) ! short wave asymmetry table
346 : real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:) ! long wave absorption table
347 : real(r8), optional, pointer :: wgtpct(:) ! weight precent of H2SO4/H2O solution
348 : integer, optional, intent(out) :: nwtp ! number of weight precent values
349 :
350 : ! hygrocoreshell table parameters
351 : real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! short wave extinction table
352 : real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:) ! short wave single-scatter albedo table
353 : real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:) ! short wave asymmetry table
354 : real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:) ! long wave absorption table
355 : real(r8), optional, pointer :: corefrac(:) ! core fraction dimension values
356 : real(r8), optional, pointer :: bcdust(:) ! bc/(bc + dust) fraction dimension values
357 : real(r8), optional, pointer :: kap(:) ! hygroscopicity dimension values
358 : real(r8), optional, pointer :: relh(:) ! relative humidity dimension values
359 : integer, optional, intent(out) :: nfrac ! core fraction dimension size
360 : integer, optional, intent(out) :: nbcdust ! bc/(bc + dust) fraction dimension size
361 : integer, optional, intent(out) :: nkap ! hygroscopicity dimension size
362 : integer, optional, intent(out) :: nrelh ! relative humidity dimension size
363 :
364 9216000 : if (present(extpsw)) then
365 0 : nullify(extpsw)
366 : end if
367 9216000 : if (present(abspsw)) then
368 0 : nullify(abspsw)
369 : end if
370 9216000 : if (present(asmpsw)) then
371 0 : nullify(asmpsw)
372 : end if
373 9216000 : if (present(absplw)) then
374 0 : nullify(absplw)
375 : end if
376 9216000 : if (present(refrtabsw)) then
377 0 : nullify(refrtabsw)
378 : end if
379 9216000 : if (present(refitabsw)) then
380 0 : nullify(refitabsw)
381 : end if
382 9216000 : if (present(refrtablw)) then
383 0 : nullify(refrtablw)
384 : end if
385 9216000 : if (present(refitablw)) then
386 0 : nullify(refitablw)
387 : end if
388 9216000 : if (present(ncoef)) then
389 0 : ncoef = huge(1)
390 : end if
391 9216000 : if (present(prefr)) then
392 0 : prefr = huge(1)
393 : end if
394 9216000 : if (present(prefi)) then
395 0 : prefi = huge(1)
396 : end if
397 :
398 : call rad_cnst_get_bin_props(list_ndx,bin_ndx, &
399 : opticstype=opticstype, &
400 : sw_hygro_ext_wtp=sw_hygro_ext_wtp, &
401 : sw_hygro_ssa_wtp=sw_hygro_ssa_wtp, &
402 : sw_hygro_asm_wtp=sw_hygro_asm_wtp, &
403 : lw_hygro_ext_wtp=lw_hygro_ext_wtp, &
404 : wgtpct=wgtpct, &
405 : nwtp=nwtp, &
406 : sw_hygro_coreshell_ext=sw_hygro_coreshell_ext, &
407 : sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa, &
408 : sw_hygro_coreshell_asm=sw_hygro_coreshell_asm, &
409 : lw_hygro_coreshell_ext=lw_hygro_coreshell_ext, &
410 : corefrac=corefrac, &
411 : bcdust=bcdust, &
412 : kap=kap, &
413 : relh=relh, &
414 : nbcdust=nbcdust, &
415 : nkap=nkap, &
416 : nrelh=nrelh, &
417 115200000 : nfrac=nfrac )
418 :
419 9216000 : end subroutine optics_params
420 :
421 : !------------------------------------------------------------------------------
422 : ! returns radius^3 (m3) of a given bin number
423 : !------------------------------------------------------------------------------
424 3433866768 : pure elemental real(r8) function amcube(self, bin_ndx, volconc, numconc)
425 :
426 : class(carma_aerosol_properties), intent(in) :: self
427 : integer, intent(in) :: bin_ndx ! bin number
428 : real(r8), intent(in) :: volconc ! volume conc (m3/m3)
429 : real(r8), intent(in) :: numconc ! number conc (1/m3)
430 :
431 3433866768 : amcube = 3._r8/(4._r8*pi)*volconc/numconc
432 :
433 3433866768 : end function amcube
434 :
435 : !------------------------------------------------------------------------------
436 : ! returns mass and number activation fractions
437 : !------------------------------------------------------------------------------
438 574012440 : subroutine actfracs(self, bin_ndx, smc, smax, fn, fm )
439 : class(carma_aerosol_properties), intent(in) :: self
440 : integer, intent(in) :: bin_ndx ! bin index
441 : real(r8),intent(in) :: smc ! critical supersaturation for particles of bin radius
442 : real(r8),intent(in) :: smax ! maximum supersaturation for multiple competing aerosols
443 : real(r8),intent(out) :: fn ! activation fraction for aerosol number
444 : real(r8),intent(out) :: fm ! activation fraction for aerosol mass
445 :
446 574012440 : fn = 0._r8
447 574012440 : fm = 0._r8
448 :
449 574012440 : if (smc < smax) then
450 363821888 : fn = 1._r8
451 363821888 : fm = 1._r8
452 : end if
453 :
454 574012440 : end subroutine actfracs
455 :
456 : !------------------------------------------------------------------------
457 : ! returns constituents names of aerosol number mixing ratios
458 : !------------------------------------------------------------------------
459 49858560 : subroutine num_names(self, bin_ndx, name_a, name_c)
460 : class(carma_aerosol_properties), intent(in) :: self
461 : integer, intent(in) :: bin_ndx ! bin number
462 : character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol number dens
463 : character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol number dens
464 :
465 49858560 : call rad_cnst_get_info_by_bin(0, bin_ndx, num_name=name_a, num_name_cw=name_c)
466 :
467 49858560 : end subroutine num_names
468 :
469 : !------------------------------------------------------------------------
470 : ! returns constituents names of aerosol mass mixing ratios
471 : !------------------------------------------------------------------------
472 54236160 : subroutine mmr_names(self, bin_ndx, species_ndx, name_a, name_c)
473 : class(carma_aerosol_properties), intent(in) :: self
474 : integer, intent(in) :: bin_ndx ! bin number
475 : integer, intent(in) :: species_ndx ! species number
476 : character(len=*), intent(out) :: name_a ! constituent name of ambient aerosol MMR
477 : character(len=*), intent(out) :: name_c ! constituent name of cloud-borne aerosol MMR
478 :
479 54236160 : if (species_ndx>0) then
480 54236160 : call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name_a, spec_name_cw=name_c)
481 : else
482 0 : call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name_a, mmr_name_cw=name_c)
483 : end if
484 :
485 54236160 : end subroutine mmr_names
486 :
487 : !------------------------------------------------------------------------
488 : ! returns constituent name of ambient aerosol number mixing ratios
489 : !------------------------------------------------------------------------
490 0 : subroutine amb_num_name(self, bin_ndx, name)
491 : class(carma_aerosol_properties), intent(in) :: self
492 : integer, intent(in) :: bin_ndx ! bin number
493 : character(len=*), intent(out) :: name ! constituent name of ambient aerosol number dens
494 :
495 0 : call rad_cnst_get_info_by_bin(0, bin_ndx, num_name=name)
496 :
497 0 : end subroutine amb_num_name
498 :
499 : !------------------------------------------------------------------------
500 : ! returns constituent name of ambient aerosol mass mixing ratios
501 : !------------------------------------------------------------------------
502 153600 : subroutine amb_mmr_name(self, bin_ndx, species_ndx, name)
503 : class(carma_aerosol_properties), intent(in) :: self
504 : integer, intent(in) :: bin_ndx ! bin number
505 : integer, intent(in) :: species_ndx ! species number
506 : character(len=*), intent(out) :: name ! constituent name of ambient aerosol MMR
507 :
508 153600 : if (species_ndx>0) then
509 92160 : call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_name=name)
510 : else
511 61440 : call rad_cnst_get_info_by_bin(0, bin_ndx, mmr_name=name)
512 : end if
513 :
514 153600 : end subroutine amb_mmr_name
515 :
516 : !------------------------------------------------------------------------
517 : ! returns species type
518 : !------------------------------------------------------------------------
519 46828019870 : subroutine species_type(self, bin_ndx, species_ndx, spectype)
520 : class(carma_aerosol_properties), intent(in) :: self
521 : integer, intent(in) :: bin_ndx ! bin number
522 : integer, intent(in) :: species_ndx ! species number
523 : character(len=*), intent(out) :: spectype ! species type
524 :
525 46828019870 : call rad_cnst_get_info_by_bin_spec(0, bin_ndx, species_ndx, spec_type=spectype)
526 :
527 46828019870 : end subroutine species_type
528 :
529 : !------------------------------------------------------------------------------
530 : ! returns TRUE if Ice Nucleation tendencies are applied to given aerosol bin number
531 : !------------------------------------------------------------------------------
532 3500853720 : function icenuc_updates_num(self, bin_ndx) result(res)
533 : class(carma_aerosol_properties), intent(in) :: self
534 : integer, intent(in) :: bin_ndx ! bin number
535 :
536 : logical :: res
537 :
538 : character(len=aero_name_len) :: spectype
539 : integer :: spc_ndx
540 :
541 3500853720 : res = .false.
542 :
543 22755549180 : do spc_ndx = 1, self%nspecies(bin_ndx)
544 19254695460 : call self%species_type( bin_ndx, spc_ndx, spectype)
545 19254695460 : if (trim(spectype)=='dust') res = .true.
546 22755549180 : if (trim(spectype)=='sulfate') res = .true.
547 : end do
548 :
549 3500853720 : end function icenuc_updates_num
550 :
551 : !------------------------------------------------------------------------------
552 : ! returns TRUE if Ice Nucleation tendencies are applied to a given species within a bin
553 : !------------------------------------------------------------------------------
554 19251178833 : function icenuc_updates_mmr(self, bin_ndx, species_ndx) result(res)
555 : class(carma_aerosol_properties), intent(in) :: self
556 : integer, intent(in) :: bin_ndx ! bin number
557 : integer, intent(in) :: species_ndx ! species number
558 :
559 : logical :: res
560 :
561 : character(len=aero_name_len) :: spectype
562 :
563 19251178833 : res = .false.
564 :
565 19251178833 : if (species_ndx==0) then
566 61440 : res = self%icenuc_updates_num(bin_ndx)
567 : else
568 19251117393 : call self%species_type( bin_ndx, species_ndx, spectype)
569 19251117393 : if (trim(spectype)=='dust') res = .true.
570 19251117393 : if (trim(spectype)=='sulfate') res = .true.
571 : end if
572 :
573 19251178833 : end function icenuc_updates_mmr
574 :
575 : !------------------------------------------------------------------------------
576 : ! apply max / min to number concentration
577 : !------------------------------------------------------------------------------
578 883670040 : subroutine apply_number_limits( self, naerosol, vaerosol, istart, istop, m )
579 : class(carma_aerosol_properties), intent(in) :: self
580 : real(r8), intent(inout) :: naerosol(:) ! number conc (1/m3)
581 : real(r8), intent(in) :: vaerosol(:) ! volume conc (m3/m3)
582 : integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols)
583 : integer, intent(in) :: istop ! stop column index
584 : integer, intent(in) :: m ! mode or bin index
585 :
586 883670040 : end subroutine apply_number_limits
587 :
588 : !------------------------------------------------------------------------------
589 : ! returns TRUE if species `spc_ndx` in aerosol subset `bin_ndx` contributes to
590 : ! the particles' ability to act as heterogeneous freezing nuclei
591 : !------------------------------------------------------------------------------
592 675840 : function hetfrz_species(self, bin_ndx, spc_ndx) result(res)
593 : class(carma_aerosol_properties), intent(in) :: self
594 : integer, intent(in) :: bin_ndx ! bin number
595 : integer, intent(in) :: spc_ndx ! species number
596 :
597 : logical :: res
598 :
599 : character(len=aero_name_len) :: species_type
600 :
601 675840 : res = .false.
602 :
603 675840 : call self%species_type(bin_ndx, spc_ndx, species_type)
604 675840 : if ( trim(species_type)=='black-c' .or. trim(species_type)=='dust' ) then
605 122880 : res = .true.
606 : end if
607 :
608 675840 : end function hetfrz_species
609 :
610 : !------------------------------------------------------------------------------
611 : ! returns TRUE if soluble
612 : !------------------------------------------------------------------------------
613 9676800 : logical function soluble(self,bin_ndx)
614 : class(carma_aerosol_properties), intent(in) :: self
615 : integer, intent(in) :: bin_ndx ! bin number
616 :
617 9676800 : soluble = .true.
618 :
619 9676800 : end function soluble
620 :
621 : !------------------------------------------------------------------------------
622 : ! returns minimum mass mean radius (meters)
623 : !------------------------------------------------------------------------------
624 9676800 : function min_mass_mean_rad(self,bin_ndx,species_ndx) result(minrad)
625 : class(carma_aerosol_properties), intent(in) :: self
626 : integer, intent(in) :: bin_ndx ! bin number
627 : integer, intent(in) :: species_ndx ! species number
628 :
629 : real(r8) :: minrad ! meters
630 :
631 9676800 : minrad = 0.0_r8
632 :
633 9676800 : end function min_mass_mean_rad
634 :
635 : !------------------------------------------------------------------------------
636 : ! returns the total number of bins for a given radiation list index
637 : !------------------------------------------------------------------------------
638 76800 : function nbins_rlist(self, list_ndx) result(res)
639 : class(carma_aerosol_properties), intent(in) :: self
640 : integer, intent(in) :: list_ndx ! radiation list number
641 :
642 : integer :: res
643 :
644 76800 : call rad_cnst_get_info(list_ndx, nbins=res)
645 :
646 76800 : end function nbins_rlist
647 :
648 : !------------------------------------------------------------------------------
649 : ! returns number of species in a bin for a given radiation list index
650 : !------------------------------------------------------------------------------
651 710860800 : function nspecies_per_bin_rlist(self, list_ndx, bin_ndx) result(res)
652 : class(carma_aerosol_properties), intent(in) :: self
653 : integer, intent(in) :: list_ndx ! radiation list number
654 : integer, intent(in) :: bin_ndx ! bin number
655 :
656 : integer :: res
657 :
658 710860800 : call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, nspec=res)
659 :
660 710860800 : end function nspecies_per_bin_rlist
661 :
662 : !------------------------------------------------------------------------------
663 : ! returns the natural log of geometric standard deviation of the number
664 : ! distribution for radiation list number and aerosol bin
665 : !------------------------------------------------------------------------------
666 0 : function alogsig_rlist(self, list_ndx, bin_ndx) result(res)
667 : class(carma_aerosol_properties), intent(in) :: self
668 : integer, intent(in) :: list_ndx ! radiation list number
669 : integer, intent(in) :: bin_ndx ! bin number
670 :
671 : real(r8) :: res
672 :
673 0 : res = self%alogsig(bin_ndx)
674 :
675 0 : end function alogsig_rlist
676 :
677 : !------------------------------------------------------------------------------
678 : ! returns name for a given radiation list number and aerosol bin
679 : !------------------------------------------------------------------------------
680 731136 : function bin_name(self, list_ndx, bin_ndx) result(name)
681 : class(carma_aerosol_properties), intent(in) :: self
682 : integer, intent(in) :: list_ndx ! radiation list number
683 : integer, intent(in) :: bin_ndx ! bin number
684 :
685 : character(len=32) name
686 :
687 731136 : call rad_cnst_get_info_by_bin(list_ndx, bin_ndx, bin_name=name)
688 :
689 731136 : end function bin_name
690 :
691 : !------------------------------------------------------------------------------
692 : ! returns scavenging diameter (cm) for a given aerosol bin number
693 : !------------------------------------------------------------------------------
694 330064380 : function scav_diam(self, bin_ndx) result(diam)
695 :
696 : use carma_intr, only: carma_get_bin_rmass
697 : use carma_intr, only: carma_get_group_by_name
698 :
699 : class(carma_aerosol_properties), intent(in) :: self
700 : integer, intent(in) :: bin_ndx ! bin number
701 :
702 : real(r8) :: diam ! cm
703 :
704 : real(r8) :: mass ! the bin mass (g)
705 : real(r8) :: rho ! density (kg/m3)
706 : integer :: ispec
707 : character(len=32) :: spectype
708 :
709 : character(len=aero_name_len) :: bin_name, shortname
710 : integer :: igroup, ibin, rc, nchr
711 :
712 330064380 : call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name)
713 :
714 330064380 : nchr = len_trim(bin_name)-2
715 330064380 : shortname = bin_name(:nchr)
716 :
717 330064380 : call carma_get_group_by_name(shortname, igroup, rc)
718 :
719 330064380 : read(bin_name(nchr+1:),*) ibin
720 :
721 330064380 : call carma_get_bin_rmass(igroup, ibin, mass, rc)
722 :
723 2145892500 : do ispec = 1, self%nspecies(bin_ndx)
724 1815828120 : call self%species_type(bin_ndx,ispec, spectype)
725 2145892500 : if (trim(spectype) == 'sulfate') then
726 330064380 : call self%get(bin_ndx,ispec,density=rho)
727 : end if
728 : end do
729 :
730 : ! specdens kg/m3 to g/cm3, convert from radius to diameter
731 330064380 : diam = 2._r8*((0.75_r8*mass / pi / (1.0e-3_r8*rho))**onethird)
732 :
733 330064380 : end function scav_diam
734 :
735 : !------------------------------------------------------------------------------
736 : ! adjust aerosol concentration tendencies to create larger sizes of aerosols
737 : ! during resuspension
738 : !------------------------------------------------------------------------------
739 2355641 : subroutine resuspension_resize(self, dcondt)
740 : class(carma_aerosol_properties), intent(in) :: self
741 : real(r8), intent(inout) :: dcondt(:)
742 :
743 : integer :: m
744 :
745 : ! move dcondt_prevap to larger bin
746 614822301 : do m = 1, self%ncnst_tot()
747 614822301 : if (self%ibl(m) /= m) then
748 581843327 : dcondt(self%ibl(m)) = dcondt(self%ibl(m)) + dcondt(m)
749 581843327 : dcondt(m) = 0._r8
750 : end if
751 : end do
752 :
753 330064380 : end subroutine resuspension_resize
754 :
755 : !------------------------------------------------------------------------------
756 : ! returns dust deposition fluxes rebinned to specified diameter limits
757 : !------------------------------------------------------------------------------
758 1161216 : subroutine rebin_bulk_fluxes(self, bulk_type, dep_fluxes, diam_edges, bulk_fluxes, &
759 : error_code, error_string)
760 :
761 : class(carma_aerosol_properties), intent(in) :: self
762 : character(len=*),intent(in) :: bulk_type ! aerosol type to rebin
763 : real(r8), intent(in) :: dep_fluxes(:) ! kg/m2/sec
764 : real(r8), intent(in) :: diam_edges(:) ! meters
765 : real(r8), intent(out) :: bulk_fluxes(:) ! kg/m2/sec
766 : integer, intent(out) :: error_code ! error code (0 if no error)
767 : character(len=*), intent(out) :: error_string ! error string
768 :
769 : real(r8) :: mflx, mflx_tot
770 : real(r8) :: rho, mass, frac, diam
771 : integer :: i, m,l,mm
772 : integer :: n_bulk_bins
773 : character(len=aero_name_len) :: spectype
774 : logical :: type_not_found
775 :
776 1161216 : error_code = 0
777 1161216 : error_string = ' '
778 :
779 1161216 : n_bulk_bins = size(bulk_fluxes)
780 :
781 5806080 : bulk_fluxes(:) = 0._r8
782 1161216 : type_not_found = .true.
783 :
784 47609856 : bin_loop: do m = 1,self%nbins()
785 :
786 46448640 : mflx_tot = 0._r8
787 46448640 : mflx = 0._r8
788 :
789 301916160 : species: do l = 1,self%nmasses(m)
790 255467520 : mm = self%indexer(m,l)
791 :
792 301916160 : if (l>self%nspecies(m)) then
793 : ! use mass flux for the entire bin (concentration element) if available
794 : ! -- override the total summed below
795 0 : mflx_tot = dep_fluxes(mm)
796 : else
797 : ! this sums up the total assuming all species are transported
798 255467520 : mflx_tot = mflx_tot + dep_fluxes(mm)
799 :
800 255467520 : call self%get(m,l,spectype=spectype)
801 :
802 255467520 : if (spectype==bulk_type) then
803 : ! get mass flux and density of the specified type
804 23224320 : mflx = dep_fluxes(mm)
805 23224320 : call self%get(m,l,density=rho) ! kg/m3
806 23224320 : type_not_found = .false.
807 : end if
808 : end if
809 : end do species
810 :
811 47609856 : if (mflx>0._r8 .and. mflx_tot>0._r8) then
812 : ! mass flux fraction
813 21019906 : frac = mflx/mflx_tot
814 :
815 : ! mass of the specified aerosol type
816 21019906 : mass = frac * bin_mass(m) ! kg
817 :
818 : ! diameter in meters
819 21019906 : diam = 2._r8*((0.75_r8*mass/pi/rho)**onethird)
820 :
821 : ! add the flux to the corresponding bulk bin
822 75340677 : blk_loop: do i = 1,n_bulk_bins-1
823 75340677 : if (diam>diam_edges(i) .and. diam<=diam_edges(i+1)) then
824 2995231 : bulk_fluxes(i) = bulk_fluxes(i) + mflx
825 2995231 : exit blk_loop
826 : end if
827 : end do blk_loop
828 : endif
829 :
830 : end do bin_loop
831 :
832 2322432 : if (type_not_found) then
833 0 : bulk_fluxes(:) = nan
834 0 : error_code = 1
835 0 : write(error_string,*) 'aerosol_properties::rebin_bulk_fluxes ERROR : ',trim(bulk_type),' not found'
836 : end if
837 :
838 : contains
839 :
840 : !---------------------------------------------------------------
841 : ! get mass of the specified bin in kg -- could be done at init time ...
842 : !---------------------------------------------------------------
843 21019906 : real(r8) function bin_mass(bin_ndx) ! (kg)
844 : use carma_intr, only: carma_get_bin_rmass, carma_get_group_by_name
845 :
846 : integer, intent(in) :: bin_ndx
847 :
848 : character(len=aero_name_len) :: bin_name, shortname
849 : integer :: ibin, igroup, rc, nchr
850 : real(r8) :: rmass
851 :
852 21019906 : call rad_cnst_get_info_by_bin(0, bin_ndx, bin_name=bin_name)
853 :
854 21019906 : nchr = len_trim(bin_name)-2
855 21019906 : shortname = bin_name(:nchr)
856 :
857 21019906 : call carma_get_group_by_name(shortname, igroup, rc)
858 :
859 21019906 : read(bin_name(nchr+1:),*) ibin
860 :
861 21019906 : call carma_get_bin_rmass(igroup, ibin, rmass, rc)
862 21019906 : bin_mass = rmass * 1.e-3_r8 ! g->kg
863 :
864 21019906 : end function bin_mass
865 :
866 : end subroutine rebin_bulk_fluxes
867 :
868 : !------------------------------------------------------------------------------
869 : ! Returns TRUE if bin is hydrophilic, otherwise FALSE
870 : !------------------------------------------------------------------------------
871 368640 : logical function hydrophilic(self, bin_ndx)
872 : class(carma_aerosol_properties), intent(in) :: self
873 : integer, intent(in) :: bin_ndx ! bin number
874 :
875 368640 : hydrophilic = .true.
876 :
877 368640 : end function hydrophilic
878 :
879 4608 : end module carma_aerosol_properties_mod
|
