Line data Source code
1 : module aerosol_state_mod
2 : use shr_kind_mod, only: r8 => shr_kind_r8
3 : use aerosol_properties_mod, only: aerosol_properties, aero_name_len
4 : use physconst, only: pi
5 :
6 : implicit none
7 :
8 : private
9 :
10 : public :: aerosol_state
11 : public :: ptr2d_t
12 :
13 : !> aerosol_state defines the interface to the time-varying aerosol state
14 : !! variables (e.g., mixing ratios, number concentrations). This includes the
15 : !! aerosol portion of the overall model state.
16 : !!
17 : !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the aerosol_state
18 : !! class to allow access to the state information (transported and not transported)
19 : !! of the aerosol package. Any package must implement each of the deferred
20 : !! procedures of the abstract aerosol_state class, may include additional private
21 : !! data members and type-bound procedures, and may override functions of the
22 : !! abstract class.
23 : !!
24 : !! Please see the modal_aerosol_state module for an example of how the aerosol_state
25 : !! class can be extended for a specific aerosol package.
26 : type, abstract :: aerosol_state
27 : contains
28 : procedure(aero_get_transported), deferred :: get_transported
29 : procedure(aero_set_transported), deferred :: set_transported
30 : procedure(aero_get_amb_total_bin_mmr), deferred :: ambient_total_bin_mmr
31 : procedure(aero_get_state_mmr), deferred :: get_ambient_mmr_0list
32 : procedure(aero_get_list_mmr), deferred :: get_ambient_mmr_rlist
33 : generic :: get_ambient_mmr=>get_ambient_mmr_0list,get_ambient_mmr_rlist
34 : procedure(aero_get_state_mmr), deferred :: get_cldbrne_mmr
35 : procedure(aero_get_state_num), deferred :: get_ambient_num
36 : procedure(aero_get_state_num), deferred :: get_cldbrne_num
37 : procedure(aero_get_states), deferred :: get_states
38 : procedure(aero_update_bin), deferred :: update_bin
39 : procedure :: loadaer
40 : procedure(aero_icenuc_size_wght_arr), deferred :: icenuc_size_wght_arr
41 : procedure(aero_icenuc_size_wght_val), deferred :: icenuc_size_wght_val
42 : generic :: icenuc_size_wght => icenuc_size_wght_arr,icenuc_size_wght_val
43 : procedure :: icenuc_type_wght_base
44 : procedure :: icenuc_type_wght => icenuc_type_wght_base
45 : procedure :: nuclice_get_numdens
46 : procedure :: get_amb_species_numdens
47 : procedure :: get_cld_species_numdens
48 : procedure :: coated_frac
49 : procedure :: mass_mean_radius
50 : procedure :: watact_mfactor
51 : procedure(aero_hetfrz_size_wght), deferred :: hetfrz_size_wght
52 : procedure(aero_hygroscopicity), deferred :: hygroscopicity
53 : procedure(aero_water_uptake), deferred :: water_uptake
54 : procedure :: refractive_index_sw
55 : procedure :: refractive_index_lw
56 : procedure(aero_volume), deferred :: dry_volume
57 : procedure(aero_volume), deferred :: wet_volume
58 : procedure(aero_volume), deferred :: water_volume
59 : end type aerosol_state
60 :
61 : ! for state fields
62 : type ptr2d_t
63 : real(r8), pointer :: fld(:,:)
64 : end type ptr2d_t
65 :
66 : real(r8), parameter :: per_cm3 = 1.e-6_r8 ! factor for m-3 to cm-3 conversions
67 : real(r8), parameter :: per_m3 = 1.e6_r8 ! factor for cm-3 to m-3 conversions
68 : real(r8), parameter :: kg2mug = 1.e9_r8 ! factor for kg to micrograms (mug) conversions
69 :
70 : abstract interface
71 :
72 : !------------------------------------------------------------------------
73 : ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer)
74 : !------------------------------------------------------------------------
75 : function aero_get_amb_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot)
76 : import :: aerosol_state, aerosol_properties, r8
77 : class(aerosol_state), intent(in) :: self
78 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
79 : integer, intent(in) :: bin_ndx ! bin index
80 : integer, intent(in) :: col_ndx ! column index
81 : integer, intent(in) :: lyr_ndx ! vertical layer index
82 :
83 : real(r8) :: mmr_tot ! mass mixing ratios totaled for all species
84 :
85 : end function aero_get_amb_total_bin_mmr
86 :
87 : !------------------------------------------------------------------------
88 : ! returns aerosol mass mixing ratio for a given species index and bin index
89 : !------------------------------------------------------------------------
90 : subroutine aero_get_state_mmr(self, species_ndx, bin_ndx, mmr)
91 : import :: aerosol_state, r8
92 : class(aerosol_state), intent(in) :: self
93 : integer, intent(in) :: species_ndx ! species index
94 : integer, intent(in) :: bin_ndx ! bin index
95 : real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev)
96 : end subroutine aero_get_state_mmr
97 :
98 : !------------------------------------------------------------------------
99 : ! returns aerosol mass mixing ratio for a given species index, bin index
100 : ! and raditaion climate or diagnsotic list number
101 : !------------------------------------------------------------------------
102 : subroutine aero_get_list_mmr(self, list_ndx, species_ndx, bin_ndx, mmr)
103 : import :: aerosol_state, r8
104 : class(aerosol_state), intent(in) :: self
105 : integer, intent(in) :: list_ndx ! rad climate/diagnostic list index
106 : integer, intent(in) :: species_ndx ! species index
107 : integer, intent(in) :: bin_ndx ! bin index
108 : real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev)
109 : end subroutine aero_get_list_mmr
110 :
111 : !------------------------------------------------------------------------
112 : ! returns aerosol number mixing ratio for a given species index and bin index
113 : !------------------------------------------------------------------------
114 : subroutine aero_get_state_num(self, bin_ndx, num)
115 : import :: aerosol_state, r8
116 : class(aerosol_state), intent(in) :: self
117 : integer, intent(in) :: bin_ndx ! bin index
118 : real(r8), pointer :: num(:,:) ! number densities (ncol,nlev)
119 : end subroutine aero_get_state_num
120 :
121 : !------------------------------------------------------------------------
122 : ! returns interstitial and cloud-borne aerosol states
123 : !------------------------------------------------------------------------
124 : subroutine aero_get_states( self, aero_props, raer, qqcw )
125 : import :: aerosol_state, aerosol_properties, ptr2d_t
126 :
127 : class(aerosol_state), intent(in) :: self
128 : class(aerosol_properties), intent(in) :: aero_props ! properties of the aerosol model
129 : type(ptr2d_t), intent(out) :: raer(:) ! state of interstitial aerosols
130 : type(ptr2d_t), intent(out) :: qqcw(:) ! state of cloud-borne aerosols
131 :
132 : end subroutine aero_get_states
133 :
134 : !------------------------------------------------------------------------------
135 : ! sets transported components
136 : ! This updates the aerosol model state from the host transported aerosol constituents array.
137 : ! (mass mixing ratios or number mixing ratios)
138 : !------------------------------------------------------------------------------
139 : subroutine aero_set_transported( self, transported_array )
140 : import :: aerosol_state, r8
141 : class(aerosol_state), intent(inout) :: self
142 : real(r8), intent(in) :: transported_array(:,:,:)
143 : end subroutine aero_set_transported
144 :
145 : !------------------------------------------------------------------------------
146 : ! returns transported components
147 : ! This updates the transported aerosol constituent array to match the aerosol model state.
148 : ! (mass mixing ratios or number mixing ratios)
149 : !------------------------------------------------------------------------------
150 : subroutine aero_get_transported( self, transported_array )
151 : import :: aerosol_state, r8
152 : class(aerosol_state), intent(in) :: self
153 : real(r8), intent(out) :: transported_array(:,:,:)
154 : end subroutine aero_get_transported
155 :
156 : !------------------------------------------------------------------------------
157 : ! return aerosol bin size weights for a given bin
158 : !------------------------------------------------------------------------------
159 : subroutine aero_icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght)
160 : import :: aerosol_state, r8
161 : class(aerosol_state), intent(in) :: self
162 : integer, intent(in) :: bin_ndx ! bin number
163 : integer, intent(in) :: ncol ! number of columns
164 : integer, intent(in) :: nlev ! number of vertical levels
165 : character(len=*), intent(in) :: species_type ! species type
166 : logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag
167 : real(r8), intent(out) :: wght(:,:)
168 :
169 : end subroutine aero_icenuc_size_wght_arr
170 :
171 : !------------------------------------------------------------------------------
172 : ! return aerosol bin size weights for a given bin, column and vertical layer
173 : !------------------------------------------------------------------------------
174 : subroutine aero_icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght)
175 : import :: aerosol_state, r8
176 : class(aerosol_state), intent(in) :: self
177 : integer, intent(in) :: bin_ndx ! bin number
178 : integer, intent(in) :: col_ndx ! column index
179 : integer, intent(in) :: lyr_ndx ! vertical layer index
180 : character(len=*), intent(in) :: species_type ! species type
181 : logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag
182 : real(r8), intent(out) :: wght
183 :
184 : end subroutine aero_icenuc_size_wght_val
185 :
186 : !------------------------------------------------------------------------------
187 : ! updates state and tendency
188 : !------------------------------------------------------------------------------
189 : subroutine aero_update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend )
190 : import :: aerosol_state, r8
191 : class(aerosol_state), intent(in) :: self
192 : integer, intent(in) :: bin_ndx ! bin number
193 : integer, intent(in) :: col_ndx ! column index
194 : integer, intent(in) :: lyr_ndx ! vertical layer index
195 : real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin
196 : real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin
197 : integer, intent(in) :: tnd_ndx ! tendency index
198 : real(r8),intent(in) :: dtime ! time step size (sec)
199 : real(r8),intent(inout) :: tend(:,:,:) ! tendency
200 :
201 : end subroutine aero_update_bin
202 :
203 : !------------------------------------------------------------------------------
204 : ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act
205 : ! as heterogeneous freezing nuclei
206 : !------------------------------------------------------------------------------
207 : function aero_hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght)
208 : import :: aerosol_state, r8
209 : class(aerosol_state), intent(in) :: self
210 : integer, intent(in) :: bin_ndx ! bin number
211 : integer, intent(in) :: ncol ! number of columns
212 : integer, intent(in) :: nlev ! number of vertical levels
213 :
214 : real(r8) :: wght(ncol,nlev)
215 :
216 : end function aero_hetfrz_size_wght
217 :
218 : !------------------------------------------------------------------------------
219 : ! returns hygroscopicity for a given radiation diagnostic list number and
220 : ! bin number
221 : !------------------------------------------------------------------------------
222 : function aero_hygroscopicity(self, list_ndx, bin_ndx) result(kappa)
223 : import :: aerosol_state, r8
224 : class(aerosol_state), intent(in) :: self
225 : integer, intent(in) :: list_ndx ! rad climate/diagnostic list index
226 : integer, intent(in) :: bin_ndx ! bin number
227 :
228 : real(r8), pointer :: kappa(:,:) ! hygroscopicity (ncol,nlev)
229 :
230 : end function aero_hygroscopicity
231 :
232 : !------------------------------------------------------------------------------
233 : ! returns aerosol wet diameter and aerosol water concentration for a given
234 : ! radiation diagnostic list number and bin number
235 : !------------------------------------------------------------------------------
236 : subroutine aero_water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat)
237 : import :: aerosol_state, aerosol_properties, r8
238 :
239 : class(aerosol_state), intent(in) :: self
240 : class(aerosol_properties), intent(in) :: aero_props
241 : integer, intent(in) :: list_idx ! rad climate/diags list number
242 : integer, intent(in) :: bin_idx ! bin number
243 : integer, intent(in) :: ncol ! number of columns
244 : integer, intent(in) :: nlev ! number of levels
245 : real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m)
246 : real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g)
247 :
248 : end subroutine aero_water_uptake
249 :
250 : !------------------------------------------------------------------------------
251 : ! aerosol volume interface
252 : !------------------------------------------------------------------------------
253 : function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
254 : import :: aerosol_state, aerosol_properties, r8
255 :
256 : class(aerosol_state), intent(in) :: self
257 : class(aerosol_properties), intent(in) :: aero_props
258 : integer, intent(in) :: list_idx ! rad climate/diags list number
259 : integer, intent(in) :: bin_idx ! bin number
260 : integer, intent(in) :: ncol ! number of columns
261 : integer, intent(in) :: nlev ! number of levels
262 :
263 : real(r8) :: vol(ncol,nlev) ! m3/kg
264 :
265 : end function aero_volume
266 :
267 : end interface
268 :
269 : contains
270 :
271 : !------------------------------------------------------------------------------
272 : ! returns aerosol number, volume concentrations, and bulk hygroscopicity
273 : !------------------------------------------------------------------------------
274 342714084 : subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, &
275 114238028 : naerosol, vaerosol, hygro, errnum, errstr)
276 :
277 : use aerosol_properties_mod, only: aerosol_properties
278 :
279 : ! input arguments
280 : class(aerosol_state), intent(in) :: self
281 : class(aerosol_properties), intent(in) :: aero_props
282 :
283 : integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols)
284 : integer, intent(in) :: istop ! stop column index
285 : integer, intent(in) :: k ! level index
286 : integer, intent(in) :: m ! mode or bin index
287 : real(r8), intent(in) :: cs(:,:) ! air density (kg/m3)
288 : integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum
289 :
290 : ! output arguments
291 : real(r8), intent(out) :: naerosol(:) ! number conc (1/m3)
292 : real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3)
293 : real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode
294 :
295 : integer , intent(out) :: errnum
296 : character(len=*), intent(out) :: errstr
297 :
298 : ! internal
299 114238028 : real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios
300 114238028 : real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios
301 : real(r8) :: specdens, spechygro
302 :
303 114238028 : real(r8) :: vol(istart:istop) ! aerosol volume mixing ratio
304 : integer :: i, l
305 : !-------------------------------------------------------------------------------
306 114238028 : errnum = 0
307 :
308 1099968664 : do i = istart, istop
309 985730636 : vaerosol(i) = 0._r8
310 1099968664 : hygro(i) = 0._r8
311 : end do
312 :
313 542630633 : do l = 1, aero_props%nspecies(m)
314 :
315 428392605 : call self%get_ambient_mmr(l,m, raer)
316 428392605 : call self%get_cldbrne_mmr(l,m, qqcw)
317 428392605 : call aero_props%get(m,l, density=specdens, hygro=spechygro)
318 :
319 428392605 : if (phase == 3) then
320 3712806720 : do i = istart, istop
321 3712806720 : vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens
322 : end do
323 206037885 : else if (phase == 2) then
324 0 : do i = istart, istop
325 0 : vol(i) = max(qqcw(i,k), 0._r8)/specdens
326 : end do
327 206037885 : else if (phase == 1) then
328 412075770 : do i = istart, istop
329 412075770 : vol(i) = max(raer(i,k), 0._r8)/specdens
330 : end do
331 : else
332 0 : errnum = -1
333 0 : write(errstr,*)'phase = ',phase,' in aerosol_state::loadaer not recognized'
334 : return
335 : end if
336 :
337 4667513123 : do i = istart, istop
338 3696489885 : vaerosol(i) = vaerosol(i) + vol(i)
339 4124882490 : hygro(i) = hygro(i) + vol(i)*spechygro
340 : end do
341 :
342 : end do
343 :
344 1099968664 : do i = istart, istop
345 1099968664 : if (vaerosol(i) > 1.0e-30_r8) then
346 985730411 : hygro(i) = hygro(i)/(vaerosol(i))
347 985730411 : vaerosol(i) = vaerosol(i)*cs(i,k)
348 : else
349 225 : hygro(i) = 0.0_r8
350 225 : vaerosol(i) = 0.0_r8
351 : end if
352 : end do
353 :
354 : ! aerosol number mixing ratios (#/kg)
355 114238028 : call self%get_ambient_num(m, raer)
356 114238028 : call self%get_cldbrne_num(m, qqcw)
357 114238028 : if (phase == 3) then
358 990081792 : do i = istart, istop
359 990081792 : naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k) ! #/kg -> #/m3
360 : end do
361 54943436 : else if (phase == 2) then
362 0 : do i = istart, istop
363 0 : naerosol(i) = qqcw(i,k)*cs(i,k)
364 : end do
365 : else
366 109886872 : do i = istart, istop
367 109886872 : naerosol(i) = raer(i,k)*cs(i,k)
368 : end do
369 : end if
370 :
371 : ! adjust number
372 114238028 : call aero_props%apply_number_limits( naerosol, vaerosol, istart, istop, m )
373 :
374 114238028 : end subroutine loadaer
375 :
376 : !------------------------------------------------------------------------------
377 : ! returns ambient aerosol number density for a given bin number and species type
378 : !------------------------------------------------------------------------------
379 2117664 : subroutine get_amb_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens)
380 : use aerosol_properties_mod, only: aerosol_properties
381 : class(aerosol_state), intent(in) :: self
382 : integer, intent(in) :: bin_ndx ! bin number
383 : integer, intent(in) :: ncol ! number of columns
384 : integer, intent(in) :: nlev ! number of vertical levels
385 : character(len=*), intent(in) :: species_type ! species type
386 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
387 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
388 : real(r8), intent(out) :: numdens(:,:) ! species number densities (#/cm^3)
389 :
390 2117664 : real(r8), pointer :: num(:,:)
391 4235328 : real(r8) :: type_wght(ncol,nlev)
392 4235328 : real(r8) :: size_wght(ncol,nlev)
393 :
394 3290603616 : size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev)
395 :
396 2117664 : call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght)
397 :
398 2117664 : call self%get_ambient_num(bin_ndx, num)
399 :
400 3290603616 : numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3
401 :
402 2117664 : end subroutine get_amb_species_numdens
403 :
404 : !------------------------------------------------------------------------------
405 : ! returns cloud-borne aerosol number density for a given bin number and species type
406 : !------------------------------------------------------------------------------
407 705888 : subroutine get_cld_species_numdens(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, numdens)
408 : use aerosol_properties_mod, only: aerosol_properties
409 : class(aerosol_state), intent(in) :: self
410 : integer, intent(in) :: bin_ndx ! bin number
411 : integer, intent(in) :: ncol ! number of columns
412 : integer, intent(in) :: nlev ! number of vertical levels
413 : character(len=*), intent(in) :: species_type ! species type
414 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
415 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
416 : real(r8), intent(out) :: numdens(:,:) ! number densities (#/cm^3)
417 :
418 705888 : real(r8), pointer :: num(:,:)
419 1411776 : real(r8) :: type_wght(ncol,nlev)
420 1411776 : real(r8) :: size_wght(ncol,nlev)
421 :
422 1096867872 : size_wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev)
423 :
424 705888 : call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, type_wght, cloud_borne=.true.)
425 :
426 705888 : call self%get_cldbrne_num(bin_ndx, num)
427 :
428 1096867872 : numdens(:ncol,:) = num(:ncol,:)*rho(:ncol,:)*type_wght(:ncol,:)*size_wght(:ncol,:)*per_cm3
429 :
430 705888 : end subroutine get_cld_species_numdens
431 :
432 : !------------------------------------------------------------------------------
433 : ! returns aerosol type weights for a given aerosol type and bin
434 : !------------------------------------------------------------------------------
435 3529440 : subroutine icenuc_type_wght_base(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
436 :
437 : use aerosol_properties_mod, only: aerosol_properties
438 :
439 : class(aerosol_state), intent(in) :: self
440 : integer, intent(in) :: bin_ndx ! bin number
441 : integer, intent(in) :: ncol ! number of columns
442 : integer, intent(in) :: nlev ! number of vertical levels
443 : character(len=*), intent(in) :: species_type ! species type
444 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
445 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
446 : real(r8), intent(out) :: wght(:,:) ! type weights
447 : logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used
448 : ! otherwise ambient aerosols are used
449 :
450 7058880 : real(r8) :: mass(ncol,nlev)
451 7058880 : real(r8) :: totalmass(ncol,nlev)
452 3529440 : real(r8), pointer :: aer_bin(:,:)
453 :
454 : character(len=aero_name_len) :: spectype, sptype
455 : integer :: ispc
456 : logical :: cldbrne
457 :
458 3529440 : if (present(cloud_borne)) then
459 705888 : cldbrne = cloud_borne
460 : else
461 : cldbrne = .false.
462 : end if
463 :
464 5484339360 : wght(:,:) = 0._r8
465 5484339360 : totalmass(:,:) = 0._r8
466 5484339360 : mass(:,:) = 0._r8
467 :
468 3529440 : if (species_type=='sulfate_strat') then
469 176472 : sptype = 'sulfate'
470 : else
471 3352968 : sptype = species_type
472 : end if
473 :
474 18353088 : do ispc = 1, aero_props%nspecies(bin_ndx)
475 :
476 14823648 : if (cldbrne) then
477 3000024 : call self%get_cldbrne_mmr(ispc, bin_ndx, aer_bin)
478 : else
479 11823624 : call self%get_ambient_mmr(ispc, bin_ndx, aer_bin)
480 : end if
481 14823648 : call aero_props%species_type(bin_ndx, ispc, spectype=spectype)
482 :
483 23034225312 : totalmass(:ncol,:) = totalmass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:)
484 :
485 18353088 : if (trim(spectype) == trim(sptype)) then
486 5484339360 : mass(:ncol,:) = mass(:ncol,:) + aer_bin(:ncol,:)*rho(:ncol,:)
487 : end if
488 :
489 : end do
490 :
491 5484339360 : where (totalmass(:ncol,:) > 0._r8)
492 3529440 : wght(:ncol,:) = mass(:ncol,:)/totalmass(:ncol,:)
493 : end where
494 :
495 7058880 : end subroutine icenuc_type_wght_base
496 :
497 : !------------------------------------------------------------------------------
498 176472 : subroutine nuclice_get_numdens(self, aero_props, use_preexisting_ice, ncol, nlev, rho, dust_num_col, sulf_num_col, soot_num_col, sulf_num_tot_col )
499 :
500 : class(aerosol_state), intent(in) :: self
501 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
502 :
503 : logical, intent(in) :: use_preexisting_ice
504 : integer, intent(in) :: ncol ! number of columns
505 : integer, intent(in) :: nlev ! number of vertical levels
506 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
507 : real(r8), intent(out) :: dust_num_col(:,:) ! dust number densities (#/cm^3)
508 : real(r8), intent(out) :: sulf_num_col(:,:) ! sulfate number densities (#/cm^3)
509 : real(r8), intent(out) :: soot_num_col(:,:) ! soot number densities (#/cm^3)
510 : real(r8), intent(out) :: sulf_num_tot_col(:,:) ! stratopsheric sulfate number densities (#/cm^3)
511 :
512 : integer :: ibin,ispc
513 : character(len=aero_name_len) :: spectype
514 352944 : real(r8) :: size_wghts(ncol,nlev)
515 352944 : real(r8) :: type_wghts(ncol,nlev)
516 :
517 176472 : real(r8), pointer :: num_col(:,:)
518 :
519 279178704 : dust_num_col(:,:) = 0._r8
520 279178704 : sulf_num_col(:,:) = 0._r8
521 279178704 : soot_num_col(:,:) = 0._r8
522 279178704 : sulf_num_tot_col(:,:) = 0._r8
523 :
524 : ! collect number densities (#/cm^3) for dust, sulfate, and soot
525 882360 : do ibin = 1,aero_props%nbins()
526 :
527 705888 : call self%get_ambient_num(ibin, num_col)
528 :
529 3352968 : do ispc = 1,aero_props%nspecies(ibin)
530 :
531 2647080 : call aero_props%species_type(ibin, ispc, spectype)
532 :
533 2647080 : call self%icenuc_size_wght(ibin, ncol, nlev, spectype, use_preexisting_ice, size_wghts)
534 :
535 2647080 : call self%icenuc_type_wght(ibin, ncol, nlev, spectype, aero_props, rho, type_wghts)
536 :
537 6000048 : select case ( trim(spectype) )
538 : case('dust')
539 529416 : dust_num_col(:ncol,:) = dust_num_col(:ncol,:) &
540 823180320 : + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3
541 : case('sulfate')
542 : ! This order of ops gives bit-for-bit results for cam5 phys ( use_preexisting_ice = .false. )
543 529416 : sulf_num_col(:ncol,:) = sulf_num_col(:ncol,:) &
544 823180320 : + num_col(:ncol,:)*rho(:ncol,:)*per_cm3 * size_wghts(:ncol,:)*type_wghts(:ncol,:)
545 : case('black-c')
546 352944 : soot_num_col(:ncol,:) = soot_num_col(:ncol,:) &
547 553728096 : + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3
548 : end select
549 :
550 : enddo
551 :
552 : ! stratospheric sulfates -- special case not included in the species loop above
553 705888 : call self%icenuc_size_wght(ibin, ncol, nlev, 'sulfate_strat', use_preexisting_ice, size_wghts)
554 705888 : call self%icenuc_type_wght(ibin, ncol, nlev, 'sulfate_strat', aero_props, rho, type_wghts)
555 705888 : sulf_num_tot_col(:ncol,:) = sulf_num_tot_col(:ncol,:) &
556 1097750232 : + size_wghts(:ncol,:)*type_wghts(:ncol,:)*num_col(:ncol,:)*rho(:ncol,:)*per_cm3
557 :
558 : enddo
559 :
560 176472 : end subroutine nuclice_get_numdens
561 :
562 : !------------------------------------------------------------------------------
563 : ! returns the fraction of particle surface area of aerosol subset `bin_ndx` covered
564 : ! by at least a monolayer of species `species_type` [0-1]
565 : !------------------------------------------------------------------------------
566 705888 : function coated_frac(self, bin_ndx, species_type, ncol, nlev, aero_props, radius) result(frac)
567 :
568 : class(aerosol_state), intent(in) :: self
569 : integer, intent(in) :: bin_ndx ! bin number
570 : character(len=*), intent(in) :: species_type ! species type
571 : integer, intent(in) :: ncol ! number of columns
572 : integer, intent(in) :: nlev ! number of vertical levels
573 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
574 : real(r8), intent(in) :: radius(:,:) ! m
575 :
576 : real(r8) :: frac(ncol,nlev) ! coated fraction
577 :
578 : !------------coated variables--------------------
579 : real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle
580 : real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10_r8
581 1411776 : real(r8) :: vol_shell(ncol,nlev)
582 1411776 : real(r8) :: vol_core(ncol,nlev)
583 : real(r8) :: alnsg, fac_volsfc
584 1411776 : real(r8) :: tmp1(ncol,nlev), tmp2(ncol,nlev)
585 705888 : real(r8),pointer :: sulf_mmr(:,:)
586 705888 : real(r8),pointer :: soa_mmr(:,:)
587 705888 : real(r8),pointer :: pom_mmr(:,:)
588 705888 : real(r8),pointer :: aer_mmr(:,:)
589 :
590 : integer :: sulf_ndx
591 : integer :: soa_ndx
592 : integer :: pom_ndx
593 : integer :: species_ndx
594 :
595 : real(r8) :: specdens_so4
596 : real(r8) :: specdens_pom
597 : real(r8) :: specdens_soa
598 : real(r8) :: specdens
599 :
600 : character(len=aero_name_len) :: spectype
601 : integer :: ispc
602 :
603 1096867872 : frac = -huge(1._r8)
604 :
605 705888 : sulf_ndx = -1
606 705888 : pom_ndx = -1
607 705888 : soa_ndx = -1
608 705888 : species_ndx = -1
609 :
610 3705912 : do ispc = 1, aero_props%nspecies(bin_ndx)
611 3000024 : call aero_props%species_type(bin_ndx, ispc, spectype)
612 :
613 6000048 : select case ( trim(spectype) )
614 : case('sulfate')
615 529416 : sulf_ndx = ispc
616 : case('p-organic')
617 529416 : pom_ndx = ispc
618 : case('s-organic')
619 6000048 : soa_ndx = ispc
620 : end select
621 3705912 : if (spectype==species_type) then
622 705888 : species_ndx = ispc
623 : end if
624 : end do
625 :
626 1096867872 : vol_shell(:ncol,:) = 0._r8
627 :
628 705888 : if (sulf_ndx>0) then
629 529416 : call aero_props%get(bin_ndx, sulf_ndx, density=specdens_so4)
630 529416 : call self%get_ambient_mmr(sulf_ndx, bin_ndx, sulf_mmr)
631 822650904 : vol_shell(:ncol,:) = vol_shell(:ncol,:) + sulf_mmr(:ncol,:)/specdens_so4
632 : end if
633 705888 : if (pom_ndx>0) then
634 529416 : call aero_props%get(bin_ndx, pom_ndx, density=specdens_pom)
635 529416 : call self%get_ambient_mmr(pom_ndx, bin_ndx, pom_mmr)
636 822650904 : vol_shell(:ncol,:) = vol_shell(:ncol,:) + pom_mmr(:ncol,:)*aero_props%pom_equivso4_factor()/specdens_pom
637 : end if
638 705888 : if (soa_ndx>0) then
639 352944 : call aero_props%get(bin_ndx, soa_ndx, density=specdens_soa)
640 352944 : call self%get_ambient_mmr(soa_ndx, bin_ndx, soa_mmr)
641 548433936 : vol_shell(:ncol,:) = vol_shell(:ncol,:) + soa_mmr(:ncol,:)*aero_props%soa_equivso4_factor()/specdens_soa
642 : end if
643 :
644 705888 : call aero_props%get(bin_ndx, species_ndx, density=specdens)
645 705888 : call self%get_ambient_mmr(species_ndx, bin_ndx, aer_mmr)
646 1096867872 : vol_core(:ncol,:) = aer_mmr(:ncol,:)/specdens
647 :
648 705888 : alnsg = aero_props%alogsig(bin_ndx)
649 705888 : fac_volsfc = exp(2.5_r8*alnsg**2)
650 :
651 1096867872 : tmp1(:ncol,:) = vol_shell(:ncol,:)*(radius(:ncol,:)*2._r8)*fac_volsfc
652 1096867872 : tmp2(:ncol,:) = max(6.0_r8*dr_so4_monolayers_dust*vol_core(:ncol,:), 0.0_r8)
653 :
654 1096867872 : where(tmp1(:ncol,:)>0._r8 .and. tmp2(:ncol,:)>0._r8)
655 : frac(:ncol,:) = tmp1(:ncol,:)/tmp2(:ncol,:)
656 : elsewhere
657 : frac(:ncol,:) = 0.001_r8
658 : end where
659 :
660 1096867872 : where(frac(:ncol,:)>1._r8)
661 : frac(:ncol,:) = 1._r8
662 : end where
663 1096867872 : where(frac(:ncol,:) < 0.001_r8)
664 : frac(:ncol,:) = 0.001_r8
665 : end where
666 :
667 705888 : end function coated_frac
668 :
669 : !------------------------------------------------------------------------------
670 : ! returns the radius [m] of particles in aerosol subset `bin_ndx` assuming all particles are
671 : ! the same size and only species `species_ndx` contributes to the particle volume
672 : !------------------------------------------------------------------------------
673 705888 : function mass_mean_radius(self, bin_ndx, species_ndx, ncol, nlev, aero_props, rho) result(radius)
674 :
675 : class(aerosol_state), intent(in) :: self
676 : integer, intent(in) :: bin_ndx ! bin number
677 : integer, intent(in) :: species_ndx ! species number
678 : integer, intent(in) :: ncol ! number of columns
679 : integer, intent(in) :: nlev ! number of vertical levels
680 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
681 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
682 :
683 : real(r8) :: radius(ncol,nlev) ! m
684 :
685 : character(len=aero_name_len) :: species_type
686 1411776 : real(r8) :: aer_numdens(ncol,nlev) ! kg/m3
687 1411776 : real(r8) :: aer_massdens(ncol,nlev) ! kg/m3
688 705888 : real(r8),pointer :: aer_mmr(:,:) ! kg/kg
689 :
690 : real(r8) :: specdens,minrad
691 1411776 : real(r8) :: wght(ncol,nlev)
692 : integer :: i,k
693 :
694 1096867872 : wght = self%hetfrz_size_wght(bin_ndx, ncol, nlev)
695 :
696 705888 : call aero_props%species_type(bin_ndx, species_ndx, spectype=species_type)
697 :
698 705888 : call aero_props%get(bin_ndx, species_ndx, density=specdens) ! kg/m3
699 705888 : call self%get_ambient_mmr(species_ndx, bin_ndx, aer_mmr) ! kg/kg
700 705888 : call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3
701 :
702 1096867872 : aer_massdens(:ncol,:) = aer_mmr(:ncol,:)*rho(:ncol,:)*wght(:ncol,:) ! kg/m3
703 :
704 705888 : minrad = aero_props%min_mass_mean_rad(bin_ndx, species_ndx)
705 :
706 66353472 : do k = 1,nlev
707 1096867872 : do i = 1,ncol
708 1096161984 : if (aer_massdens(i,k)*1.0e-3_r8 > 1.0e-30_r8 .and. aer_numdens(i,k) > 1.0e-3_r8) then
709 583205383 : radius(i,k) = (3._r8/(4*pi*specdens)*aer_massdens(i,k)/(aer_numdens(i,k)*per_m3))**(1._r8/3._r8) ! m
710 : else
711 447309017 : radius(i,k) = minrad
712 : end if
713 : end do
714 : end do
715 :
716 705888 : end function mass_mean_radius
717 :
718 : !------------------------------------------------------------------------------
719 : ! calculates water activity mass factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3]
720 : ! of species `species_type` in subset `bin_ndx`
721 : !------------------------------------------------------------------------------
722 705888 : subroutine watact_mfactor(self, bin_ndx, species_type, ncol, nlev, aero_props, rho, wact_factor)
723 :
724 : class(aerosol_state), intent(in) :: self
725 : integer, intent(in) :: bin_ndx ! bin number
726 : character(len=*), intent(in) :: species_type ! species type
727 : integer, intent(in) :: ncol ! number of columns
728 : integer, intent(in) :: nlev ! number of vertical levels
729 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
730 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
731 : real(r8), intent(out) :: wact_factor(:,:) ! water activity factor -- density*(1.-(OC+BC)/(OC+BC+SO4)) [mug m-3]
732 :
733 705888 : real(r8), pointer :: aer_mmr(:,:)
734 705888 : real(r8), pointer :: bin_num(:,:)
735 1411776 : real(r8) :: tot2_mmr(ncol,nlev)
736 1411776 : real(r8) :: tot1_mmr(ncol,nlev)
737 1411776 : real(r8) :: aer_numdens(ncol,nlev)
738 : integer :: ispc
739 : character(len=aero_name_len) :: spectype
740 :
741 1411776 : real(r8) :: awcam(ncol,nlev) ! mass density [mug m-3]
742 1411776 : real(r8) :: awfacm(ncol,nlev) ! mass factor ! (OC+BC)/(OC+BC+SO4)
743 :
744 1096867872 : tot2_mmr = 0.0_r8
745 1096867872 : tot1_mmr = 0.0_r8
746 :
747 705888 : if (aero_props%soluble(bin_ndx)) then
748 :
749 3176496 : do ispc = 1, aero_props%nspecies(bin_ndx)
750 :
751 2647080 : call aero_props%species_type(bin_ndx, ispc, spectype)
752 :
753 2647080 : if (trim(spectype)=='black-c' .or. trim(spectype)=='p-organic' .or. trim(spectype)=='s-organic') then
754 1058832 : call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr)
755 1645301808 : tot2_mmr(:ncol,:) = tot2_mmr(:ncol,:) + aer_mmr(:ncol,:)
756 : end if
757 3176496 : if (trim(spectype)=='sulfate') then
758 529416 : call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr)
759 822650904 : tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + aer_mmr(:ncol,:)
760 : end if
761 : end do
762 :
763 : end if
764 :
765 1096867872 : tot1_mmr(:ncol,:) = tot1_mmr(:ncol,:) + tot2_mmr(:ncol,:)
766 :
767 705888 : call self%get_amb_species_numdens(bin_ndx, ncol, nlev, species_type, aero_props, rho, aer_numdens) ! #/cm3
768 705888 : call self%get_ambient_num(bin_ndx, bin_num) ! #/kg
769 :
770 1096867872 : where(bin_num(:ncol,:)>0._r8)
771 705888 : awcam(:ncol,:) = ((aer_numdens(:ncol,:)*per_m3/bin_num(:ncol,:)) * tot1_mmr(:ncol,:)) * kg2mug ! [mug m-3]
772 : elsewhere
773 : awcam(:ncol,:) = 0._r8
774 : end where
775 :
776 1096867872 : where(tot1_mmr(:ncol,:)>0)
777 : awfacm(:ncol,:) = tot2_mmr(:ncol,:) / tot1_mmr(:ncol,:)
778 : elsewhere
779 : awfacm(:ncol,:) = 0._r8
780 : end where
781 :
782 1096867872 : wact_factor(:ncol,:) = awcam(:ncol,:)*(1._r8-awfacm(:ncol,:))
783 :
784 705888 : end subroutine watact_mfactor
785 :
786 : !------------------------------------------------------------------------------
787 : ! aerosol short wave refactive index
788 : !------------------------------------------------------------------------------
789 161239680 : function refractive_index_sw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin)
790 :
791 : class(aerosol_state), intent(in) :: self
792 : integer, intent(in) :: ncol ! number of columes
793 : integer, intent(in) :: ilev ! level index
794 : integer, intent(in) :: ilist ! radiation diagnostics list index
795 : integer, intent(in) :: ibin ! bin index
796 : integer, intent(in) :: iwav ! wave length index
797 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
798 :
799 : complex(r8) :: crefin(ncol) ! complex refractive index
800 :
801 161239680 : real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio
802 161239680 : complex(r8), pointer :: specrefindex(:) ! species refractive index
803 : real(r8) :: specdens ! species density (kg/m3)
804 : integer :: ispec, icol
805 322479360 : real(r8) :: vol(ncol)
806 :
807 2692327680 : crefin(:ncol) = (0._r8, 0._r8)
808 :
809 765888480 : do ispec = 1, aero_props%nspecies(ilist,ibin)
810 :
811 604648800 : call self%get_ambient_mmr(ilist,ispec,ibin,specmmr)
812 604648800 : call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_sw=specrefindex)
813 :
814 10257468480 : do icol = 1, ncol
815 9491580000 : vol(icol) = specmmr(icol,ilev)/specdens
816 10096228800 : crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav)
817 : end do
818 : end do
819 :
820 161239680 : end function refractive_index_sw
821 :
822 : !------------------------------------------------------------------------------
823 : ! aerosol long wave refactive index
824 : !------------------------------------------------------------------------------
825 184273920 : function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) result(crefin)
826 :
827 : class(aerosol_state), intent(in) :: self
828 : integer, intent(in) :: ncol ! number of columes
829 : integer, intent(in) :: ilev ! level index
830 : integer, intent(in) :: ilist ! radiation diagnostics list index
831 : integer, intent(in) :: ibin ! bin index
832 : integer, intent(in) :: iwav ! wave length index
833 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
834 :
835 : complex(r8) :: crefin(ncol) ! complex refractive index
836 :
837 184273920 : real(r8), pointer :: specmmr(:,:) ! species mass mixing ratio
838 184273920 : complex(r8), pointer :: specrefindex(:) ! species refractive index
839 : real(r8) :: specdens ! species density (kg/m3)
840 : integer :: ispec, icol
841 368547840 : real(r8) :: vol(ncol)
842 :
843 3076945920 : crefin(:ncol) = (0._r8, 0._r8)
844 :
845 875301120 : do ispec = 1, aero_props%nspecies(ilist,ibin)
846 :
847 691027200 : call self%get_ambient_mmr(ilist,ispec,ibin,specmmr)
848 691027200 : call aero_props%get(ibin, ispec, list_ndx=ilist, density=specdens, refindex_lw=specrefindex)
849 :
850 11722821120 : do icol = 1, ncol
851 10847520000 : vol(icol) = specmmr(icol,ilev)/specdens
852 11538547200 : crefin(icol) = crefin(icol) + vol(icol)*specrefindex(iwav)
853 : end do
854 : end do
855 :
856 184273920 : end function refractive_index_lw
857 :
858 0 : end module aerosol_state_mod
|
