Line data Source code
1 : module modal_aerosol_state_mod
2 : use shr_kind_mod, only: r8 => shr_kind_r8
3 : use shr_spfn_mod, only: erf => shr_spfn_erf
4 : use aerosol_state_mod, only: aerosol_state, ptr2d_t
5 : use rad_constituents, only: rad_cnst_get_aer_mmr, rad_cnst_get_mode_num, rad_cnst_get_info
6 : use rad_constituents, only: rad_cnst_get_mode_props
7 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index
8 : use physics_types, only: physics_state
9 : use aerosol_properties_mod, only: aerosol_properties, aero_name_len
10 : use physconst, only: rhoh2o
11 :
12 : implicit none
13 :
14 : private
15 :
16 : public :: modal_aerosol_state
17 :
18 : type, extends(aerosol_state) :: modal_aerosol_state
19 : private
20 : type(physics_state), pointer :: state => null()
21 : type(physics_buffer_desc), pointer :: pbuf(:) => null()
22 : contains
23 :
24 : procedure :: get_transported
25 : procedure :: set_transported
26 : procedure :: ambient_total_bin_mmr
27 : procedure :: get_ambient_mmr_0list
28 : procedure :: get_ambient_mmr_rlist
29 : procedure :: get_cldbrne_mmr
30 : procedure :: get_ambient_num
31 : procedure :: get_cldbrne_num
32 : procedure :: get_states
33 : procedure :: icenuc_size_wght_arr
34 : procedure :: icenuc_size_wght_val
35 : procedure :: icenuc_type_wght
36 : procedure :: update_bin
37 : procedure :: hetfrz_size_wght
38 : procedure :: hygroscopicity
39 : procedure :: water_uptake
40 : procedure :: dry_volume
41 : procedure :: wet_volume
42 : procedure :: water_volume
43 : procedure :: wet_diameter
44 : procedure :: convcld_actfrac
45 : procedure :: wgtpct
46 :
47 : final :: destructor
48 :
49 : end type modal_aerosol_state
50 :
51 : interface modal_aerosol_state
52 : procedure :: constructor
53 : end interface modal_aerosol_state
54 :
55 : real(r8), parameter :: rh2odens = 1._r8/rhoh2o
56 :
57 : contains
58 :
59 : !------------------------------------------------------------------------------
60 : !------------------------------------------------------------------------------
61 407040 : function constructor(state,pbuf) result(newobj)
62 : type(physics_state), target :: state
63 : type(physics_buffer_desc), pointer :: pbuf(:)
64 :
65 : type(modal_aerosol_state), pointer :: newobj
66 :
67 : integer :: ierr
68 :
69 407040 : allocate(newobj,stat=ierr)
70 407040 : if( ierr /= 0 ) then
71 407040 : nullify(newobj)
72 : return
73 : end if
74 :
75 407040 : newobj%state => state
76 407040 : newobj%pbuf => pbuf
77 :
78 407040 : end function constructor
79 :
80 : !------------------------------------------------------------------------------
81 : !------------------------------------------------------------------------------
82 407040 : subroutine destructor(self)
83 : type(modal_aerosol_state), intent(inout) :: self
84 :
85 407040 : nullify(self%state)
86 407040 : nullify(self%pbuf)
87 :
88 407040 : end subroutine destructor
89 :
90 : !------------------------------------------------------------------------------
91 : ! sets transported components
92 : ! This aerosol model with the state of the transported aerosol constituents
93 : ! (mass mixing ratios or number mixing ratios)
94 : !------------------------------------------------------------------------------
95 0 : subroutine set_transported( self, transported_array )
96 : class(modal_aerosol_state), intent(inout) :: self
97 : real(r8), intent(in) :: transported_array(:,:,:)
98 : ! to be implemented later
99 0 : end subroutine set_transported
100 :
101 : !------------------------------------------------------------------------------
102 : ! returns transported components
103 : ! This returns to current state of the transported aerosol constituents
104 : ! (mass mixing ratios or number mixing ratios)
105 : !------------------------------------------------------------------------------
106 0 : subroutine get_transported( self, transported_array )
107 : class(modal_aerosol_state), intent(in) :: self
108 : real(r8), intent(out) :: transported_array(:,:,:)
109 : ! to be implemented later
110 0 : end subroutine get_transported
111 :
112 : !------------------------------------------------------------------------
113 : ! Total aerosol mass mixing ratio for a bin in a given grid box location (column and layer)
114 : !------------------------------------------------------------------------
115 0 : function ambient_total_bin_mmr(self, aero_props, bin_ndx, col_ndx, lyr_ndx) result(mmr_tot)
116 : class(modal_aerosol_state), intent(in) :: self
117 : class(aerosol_properties), intent(in) :: aero_props
118 : integer, intent(in) :: bin_ndx ! bin index
119 : integer, intent(in) :: col_ndx ! column index
120 : integer, intent(in) :: lyr_ndx ! vertical layer index
121 :
122 : real(r8) :: mmr_tot ! mass mixing ratios totaled for all species
123 0 : real(r8),pointer :: mmrptr(:,:)
124 : integer :: spec_ndx
125 :
126 0 : mmr_tot = 0._r8
127 :
128 0 : do spec_ndx=1,aero_props%nspecies(bin_ndx)
129 0 : call rad_cnst_get_aer_mmr(0, bin_ndx, spec_ndx, 'a', self%state, self%pbuf, mmrptr)
130 0 : mmr_tot = mmr_tot + mmrptr(col_ndx,lyr_ndx)
131 : end do
132 :
133 0 : end function ambient_total_bin_mmr
134 :
135 : !------------------------------------------------------------------------------
136 : ! returns ambient aerosol mass mixing ratio for a given species index and bin index
137 : !------------------------------------------------------------------------------
138 1096994080 : subroutine get_ambient_mmr_0list(self, species_ndx, bin_ndx, mmr)
139 : class(modal_aerosol_state), intent(in) :: self
140 : integer, intent(in) :: species_ndx ! species index
141 : integer, intent(in) :: bin_ndx ! bin index
142 : real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev)
143 :
144 1096994080 : call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr)
145 1096994080 : end subroutine get_ambient_mmr_0list
146 :
147 : !------------------------------------------------------------------------------
148 : ! returns ambient aerosol mass mixing ratio for a given radiation diagnostics
149 : ! list index, species index and bin index
150 : !------------------------------------------------------------------------------
151 2624517120 : subroutine get_ambient_mmr_rlist(self, list_ndx, species_ndx, bin_ndx, mmr)
152 : class(modal_aerosol_state), intent(in) :: self
153 : integer, intent(in) :: list_ndx ! rad climate list index
154 : integer, intent(in) :: species_ndx ! species index
155 : integer, intent(in) :: bin_ndx ! bin index
156 : real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev)
157 :
158 2624517120 : call rad_cnst_get_aer_mmr(list_ndx, bin_ndx, species_ndx, 'a', self%state, self%pbuf, mmr)
159 2624517120 : end subroutine get_ambient_mmr_rlist
160 :
161 : !------------------------------------------------------------------------------
162 : ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index
163 : !------------------------------------------------------------------------------
164 1049335840 : subroutine get_cldbrne_mmr(self, species_ndx, bin_ndx, mmr)
165 : class(modal_aerosol_state), intent(in) :: self
166 : integer, intent(in) :: species_ndx ! species index
167 : integer, intent(in) :: bin_ndx ! bin index
168 : real(r8), pointer :: mmr(:,:) ! mass mixing ratios (ncol,nlev)
169 :
170 1049335840 : call rad_cnst_get_aer_mmr(0, bin_ndx, species_ndx, 'c', self%state, self%pbuf, mmr)
171 1049335840 : end subroutine get_cldbrne_mmr
172 :
173 : !------------------------------------------------------------------------------
174 : ! returns ambient aerosol number mixing ratio for a given species index and bin index
175 : !------------------------------------------------------------------------------
176 197340763 : subroutine get_ambient_num(self, bin_ndx, num)
177 : class(modal_aerosol_state), intent(in) :: self
178 : integer, intent(in) :: bin_ndx ! bin index
179 : real(r8), pointer :: num(:,:) ! number densities
180 :
181 197340763 : call rad_cnst_get_mode_num(0, bin_ndx, 'a', self%state, self%pbuf, num)
182 197340763 : end subroutine get_ambient_num
183 :
184 : !------------------------------------------------------------------------------
185 : ! returns cloud-borne aerosol number mixing ratio for a given species index and bin index
186 : !------------------------------------------------------------------------------
187 192018523 : subroutine get_cldbrne_num(self, bin_ndx, num)
188 : class(modal_aerosol_state), intent(in) :: self
189 : integer, intent(in) :: bin_ndx ! bin index
190 : real(r8), pointer :: num(:,:)
191 :
192 192018523 : call rad_cnst_get_mode_num(0, bin_ndx, 'c', self%state, self%pbuf, num)
193 192018523 : end subroutine get_cldbrne_num
194 :
195 : !------------------------------------------------------------------------------
196 : ! returns interstitial and cloud-borne aerosol states
197 : !------------------------------------------------------------------------------
198 403200 : subroutine get_states( self, aero_props, raer, qqcw )
199 : class(modal_aerosol_state), intent(in) :: self
200 : class(aerosol_properties), intent(in) :: aero_props
201 : type(ptr2d_t), intent(out) :: raer(:)
202 : type(ptr2d_t), intent(out) :: qqcw(:)
203 :
204 : integer :: ibin,ispc, indx
205 :
206 2419200 : do ibin = 1, aero_props%nbins()
207 2016000 : indx = aero_props%indexer(ibin, 0)
208 2016000 : call self%get_ambient_num(ibin, raer(indx)%fld)
209 2016000 : call self%get_cldbrne_num(ibin, qqcw(indx)%fld)
210 22982400 : do ispc = 1, aero_props%nspecies(ibin)
211 18547200 : indx = aero_props%indexer(ibin, ispc)
212 18547200 : call self%get_ambient_mmr(ispc,ibin, raer(indx)%fld)
213 20563200 : call self%get_cldbrne_mmr(ispc,ibin, qqcw(indx)%fld)
214 : end do
215 : end do
216 :
217 403200 : end subroutine get_states
218 :
219 : !------------------------------------------------------------------------------
220 : ! return aerosol bin size weights for a given bin
221 : !------------------------------------------------------------------------------
222 23466240 : subroutine icenuc_size_wght_arr(self, bin_ndx, ncol, nlev, species_type, use_preexisting_ice, wght)
223 : class(modal_aerosol_state), intent(in) :: self
224 : integer, intent(in) :: bin_ndx ! bin number
225 : integer, intent(in) :: ncol ! number of columns
226 : integer, intent(in) :: nlev ! number of vertical levels
227 : character(len=*), intent(in) :: species_type ! species type
228 : logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag
229 : real(r8), intent(out) :: wght(:,:)
230 :
231 : character(len=aero_name_len) :: modetype
232 23466240 : real(r8), pointer :: dgnum(:,:,:) ! mode dry radius
233 : real(r8) :: sigmag_aitken
234 : integer :: i,k
235 :
236 23466240 : call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
237 :
238 11587629312 : wght = 0._r8
239 :
240 46932480 : select case ( trim(species_type) )
241 : case('dust')
242 1451520 : if (modetype=='coarse' .or. modetype=='coarse_dust') then
243 238920192 : wght(:ncol,:) = 1._r8
244 : end if
245 : case('sulfate')
246 1935360 : if (modetype=='aitken') then
247 483840 : if ( use_preexisting_ice ) then
248 238920192 : wght(:ncol,:) = 1._r8
249 : else
250 0 : call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken)
251 0 : call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum)
252 0 : do k = 1,nlev
253 0 : do i = 1,ncol
254 0 : if (dgnum(i,k,bin_ndx) > 0._r8) then
255 : ! only allow so4 with D>0.1 um in ice nucleation
256 0 : wght(i,k) = max(0._r8,(0.5_r8 - 0.5_r8* &
257 : erf(log(0.1e-6_r8/dgnum(i,k,bin_ndx))/ &
258 0 : (2._r8**0.5_r8*log(sigmag_aitken))) ))
259 : end if
260 : end do
261 : end do
262 : endif
263 : endif
264 : case('black-c')
265 967680 : if (modetype=='accum') then
266 238920192 : wght(:ncol,:) = 1._r8
267 : endif
268 : case('sulfate_strat')
269 46932480 : if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then
270 358380288 : wght(:ncol,:) = 1._r8
271 : endif
272 : end select
273 :
274 23466240 : end subroutine icenuc_size_wght_arr
275 :
276 : !------------------------------------------------------------------------------
277 : ! return aerosol bin size weights for a given bin, column and vertical layer
278 : !------------------------------------------------------------------------------
279 0 : subroutine icenuc_size_wght_val(self, bin_ndx, col_ndx, lyr_ndx, species_type, use_preexisting_ice, wght)
280 : class(modal_aerosol_state), intent(in) :: self
281 : integer, intent(in) :: bin_ndx ! bin number
282 : integer, intent(in) :: col_ndx ! column index
283 : integer, intent(in) :: lyr_ndx ! vertical layer index
284 : character(len=*), intent(in) :: species_type ! species type
285 : logical, intent(in) :: use_preexisting_ice ! pre-existing ice flag
286 : real(r8), intent(out) :: wght
287 :
288 : character(len=aero_name_len) :: modetype
289 0 : real(r8), pointer :: dgnum(:,:,:) ! mode dry radius
290 : real(r8) :: sigmag_aitken
291 :
292 0 : wght = 0._r8
293 :
294 0 : call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
295 :
296 0 : select case ( trim(species_type) )
297 : case('dust')
298 0 : if (modetype=='coarse' .or. modetype=='coarse_dust') then
299 0 : wght = 1._r8
300 : end if
301 : case('sulfate')
302 0 : if (modetype=='aitken') then
303 0 : if ( use_preexisting_ice ) then
304 0 : wght = 1._r8
305 : else
306 0 : call rad_cnst_get_mode_props(0, bin_ndx, sigmag=sigmag_aitken)
307 0 : call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUM' ), dgnum)
308 :
309 0 : if (dgnum(col_ndx,lyr_ndx,bin_ndx) > 0._r8) then
310 : ! only allow so4 with D>0.1 um in ice nucleation
311 : wght = max(0._r8,(0.5_r8 - 0.5_r8* &
312 : erf(log(0.1e-6_r8/dgnum(col_ndx,lyr_ndx,bin_ndx))/ &
313 0 : (2._r8**0.5_r8*log(sigmag_aitken))) ))
314 :
315 : end if
316 : endif
317 : endif
318 : case('black-c')
319 0 : if (modetype=='accum') then
320 0 : wght = 1._r8
321 : endif
322 : case('sulfate_strat')
323 0 : if (modetype=='accum' .or. modetype=='coarse' .or. modetype=='coarse_strat') then
324 0 : wght = 1._r8
325 : endif
326 : end select
327 :
328 0 : end subroutine icenuc_size_wght_val
329 :
330 : !------------------------------------------------------------------------------
331 : ! returns aerosol type weights for a given aerosol type and bin
332 : !------------------------------------------------------------------------------
333 12337920 : subroutine icenuc_type_wght(self, bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
334 :
335 : use aerosol_properties_mod, only: aerosol_properties
336 :
337 : class(modal_aerosol_state), intent(in) :: self
338 : integer, intent(in) :: bin_ndx ! bin number
339 : integer, intent(in) :: ncol ! number of columns
340 : integer, intent(in) :: nlev ! number of vertical levels
341 : character(len=*), intent(in) :: species_type ! species type
342 : class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object
343 : real(r8), intent(in) :: rho(:,:) ! air density (kg m-3)
344 : real(r8), intent(out) :: wght(:,:) ! type weights
345 : logical, optional, intent(in) :: cloud_borne ! if TRUE cloud-borne aerosols are used
346 : ! otherwise ambient aerosols are used
347 :
348 : character(len=aero_name_len) :: modetype
349 :
350 12337920 : call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
351 :
352 6092464896 : wght = 0._r8
353 :
354 12337920 : if (species_type == 'dust') then
355 725760 : if (modetype=='coarse_dust') then
356 0 : wght(:ncol,:) = 1._r8
357 : else
358 725760 : call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
359 : end if
360 11612160 : else if (species_type == 'sulfate_strat') then
361 1209600 : if (modetype=='accum') then
362 119460096 : wght(:ncol,:) = 1._r8
363 967680 : elseif ( modetype=='coarse' .or. modetype=='coarse_strat') then
364 483840 : call self%icenuc_type_wght_base(bin_ndx, ncol, nlev, species_type, aero_props, rho, wght, cloud_borne)
365 : endif
366 : else
367 5136784128 : wght(:ncol,:) = 1._r8
368 : end if
369 :
370 12337920 : end subroutine icenuc_type_wght
371 :
372 : !------------------------------------------------------------------------------
373 : !------------------------------------------------------------------------------
374 87798058 : subroutine update_bin( self, bin_ndx, col_ndx, lyr_ndx, delmmr_sum, delnum_sum, tnd_ndx, dtime, tend )
375 : class(modal_aerosol_state), intent(in) :: self
376 : integer, intent(in) :: bin_ndx ! bin number
377 : integer, intent(in) :: col_ndx ! column index
378 : integer, intent(in) :: lyr_ndx ! vertical layer index
379 : real(r8),intent(in) :: delmmr_sum ! mass mixing ratio change summed over all species in bin
380 : real(r8),intent(in) :: delnum_sum ! number mixing ratio change summed over all species in bin
381 : integer, intent(in) :: tnd_ndx ! tendency index
382 : real(r8),intent(in) :: dtime ! time step size (sec)
383 : real(r8),intent(inout) :: tend(:,:,:) ! tendency
384 :
385 87798058 : real(r8), pointer :: amb_num(:,:)
386 87798058 : real(r8), pointer :: cld_num(:,:)
387 :
388 87798058 : call self%get_ambient_num(bin_ndx, amb_num)
389 87798058 : call self%get_cldbrne_num(bin_ndx, cld_num)
390 :
391 : ! if there is no bin mass compute updates/tendencies for bin number
392 : ! -- apply the total number change to bin number
393 87798058 : if (tnd_ndx>0) then
394 87798058 : tend(col_ndx,lyr_ndx,tnd_ndx) = -delnum_sum/dtime
395 : else
396 0 : amb_num(col_ndx,lyr_ndx) = amb_num(col_ndx,lyr_ndx) - delnum_sum
397 : end if
398 :
399 : ! apply the total number change to bin number
400 87798058 : cld_num(col_ndx,lyr_ndx) = cld_num(col_ndx,lyr_ndx) + delnum_sum
401 :
402 87798058 : end subroutine update_bin
403 :
404 : !------------------------------------------------------------------------------
405 : ! returns the volume-weighted fractions of aerosol subset `bin_ndx` that can act
406 : ! as heterogeneous freezing nuclei
407 : !------------------------------------------------------------------------------
408 9676800 : function hetfrz_size_wght(self, bin_ndx, ncol, nlev) result(wght)
409 : class(modal_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 :
414 : real(r8) :: wght(ncol,nlev)
415 :
416 : character(len=aero_name_len) :: modetype
417 :
418 2389201920 : wght(:,:) = 1._r8
419 :
420 4838400 : call rad_cnst_get_info(0, bin_ndx, mode_type=modetype)
421 :
422 4838400 : if (trim(modetype) == 'aitken') then
423 0 : wght(:,:) = 0._r8
424 : end if
425 :
426 4838400 : end function hetfrz_size_wght
427 :
428 : !------------------------------------------------------------------------------
429 : ! returns hygroscopicity for a given radiation diagnostic list number and
430 : ! bin number
431 : !------------------------------------------------------------------------------
432 0 : subroutine hygroscopicity(self, list_ndx, bin_ndx, kappa)
433 : class(modal_aerosol_state), intent(in) :: self
434 : integer, intent(in) :: list_ndx ! rad climate list number
435 : integer, intent(in) :: bin_ndx ! bin number
436 : real(r8), intent(out) :: kappa(:,:) ! hygroscopicity (ncol,nlev)
437 :
438 0 : kappa = -huge(1._r8)
439 :
440 0 : end subroutine hygroscopicity
441 :
442 : !------------------------------------------------------------------------------
443 : ! returns aerosol wet diameter and aerosol water concentration for a given
444 : ! radiation diagnostic list number and bin number
445 : !------------------------------------------------------------------------------
446 1536000 : subroutine water_uptake(self, aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat)
447 : use modal_aero_wateruptake, only: modal_aero_wateruptake_dr
448 : use modal_aero_calcsize, only: modal_aero_calcsize_diag
449 :
450 : class(modal_aerosol_state), intent(in) :: self
451 : class(aerosol_properties), intent(in) :: aero_props
452 : integer, intent(in) :: list_idx ! rad climate/diags list number
453 : integer, intent(in) :: bin_idx ! bin number
454 : integer, intent(in) :: ncol ! number of columns
455 : integer, intent(in) :: nlev ! number of levels
456 : real(r8),intent(out) :: dgnumwet(ncol,nlev) ! aerosol wet diameter (m)
457 : real(r8),intent(out) :: qaerwat(ncol,nlev) ! aerosol water concentration (g/g)
458 :
459 : integer :: istat, nmodes
460 768000 : real(r8), pointer :: dgnumdry_m(:,:,:) ! number mode dry diameter for all modes
461 768000 : real(r8), pointer :: dgnumwet_m(:,:,:) ! number mode wet diameter for all modes
462 768000 : real(r8), pointer :: qaerwat_m(:,:,:) ! aerosol water (g/g) for all modes
463 768000 : real(r8), pointer :: wetdens_m(:,:,:) !
464 768000 : real(r8), pointer :: hygro_m(:,:,:) !
465 768000 : real(r8), pointer :: dryvol_m(:,:,:) !
466 768000 : real(r8), pointer :: dryrad_m(:,:,:) !
467 768000 : real(r8), pointer :: drymass_m(:,:,:) !
468 768000 : real(r8), pointer :: so4dryvol_m(:,:,:) !
469 768000 : real(r8), pointer :: naer_m(:,:,:) !
470 :
471 1536000 : nmodes = aero_props%nbins()
472 :
473 768000 : if (list_idx == 0) then
474 : ! water uptake and wet radius for the climate list has already been calculated
475 768000 : call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet_m)
476 768000 : call pbuf_get_field(self%pbuf, pbuf_get_index('QAERWAT'), qaerwat_m)
477 :
478 379238400 : dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx)
479 379238400 : qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx)
480 :
481 : else
482 : ! If doing a diagnostic calculation then need to calculate the wet radius
483 : ! and water uptake for the diagnostic modes
484 : allocate(dgnumdry_m(ncol,nlev,nmodes), dgnumwet_m(ncol,nlev,nmodes), &
485 : qaerwat_m(ncol,nlev,nmodes), wetdens_m(ncol,nlev,nmodes), &
486 : hygro_m(ncol,nlev,nmodes), dryvol_m(ncol,nlev,nmodes), &
487 : dryrad_m(ncol,nlev,nmodes), drymass_m(ncol,nlev,nmodes), &
488 0 : so4dryvol_m(ncol,nlev,nmodes), naer_m(ncol,nlev,nmodes), stat=istat)
489 0 : if (istat > 0) then
490 0 : dgnumwet = -huge(1._r8)
491 0 : qaerwat = -huge(1._r8)
492 : return
493 : end if
494 : call modal_aero_calcsize_diag(self%state, self%pbuf, list_idx, dgnumdry_m, hygro_m, &
495 0 : dryvol_m, dryrad_m, drymass_m, so4dryvol_m, naer_m)
496 : call modal_aero_wateruptake_dr(self%state, self%pbuf, list_idx, dgnumdry_m, dgnumwet_m, &
497 : qaerwat_m, wetdens_m, hygro_m, dryvol_m, dryrad_m, &
498 0 : drymass_m, so4dryvol_m, naer_m)
499 :
500 0 : dgnumwet(:ncol,:nlev) = dgnumwet_m(:ncol,:nlev,bin_idx)
501 0 : qaerwat (:ncol,:nlev) = qaerwat_m(:ncol,:nlev,bin_idx)
502 :
503 0 : deallocate(dgnumdry_m)
504 0 : deallocate(dgnumwet_m)
505 0 : deallocate(qaerwat_m)
506 0 : deallocate(wetdens_m)
507 0 : deallocate(hygro_m)
508 0 : deallocate(dryvol_m)
509 0 : deallocate(dryrad_m)
510 0 : deallocate(drymass_m)
511 0 : deallocate(so4dryvol_m)
512 0 : deallocate(naer_m)
513 : endif
514 :
515 :
516 1536000 : end subroutine water_uptake
517 :
518 : !------------------------------------------------------------------------------
519 : ! aerosol dry volume (m3/kg) for given radiation diagnostic list number and bin number
520 : !------------------------------------------------------------------------------
521 768000 : function dry_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
522 :
523 : class(modal_aerosol_state), intent(in) :: self
524 : class(aerosol_properties), intent(in) :: aero_props
525 :
526 : integer, intent(in) :: list_idx ! rad climate/diags list number
527 : integer, intent(in) :: bin_idx ! bin number
528 : integer, intent(in) :: ncol ! number of columns
529 : integer, intent(in) :: nlev ! number of levels
530 :
531 : real(r8) :: vol(ncol,nlev) ! m3/kg
532 :
533 192000 : real(r8), pointer :: mmr(:,:)
534 : real(r8) :: specdens ! species density (kg/m3)
535 :
536 : integer :: ispec
537 :
538 94809600 : vol(:,:) = 0._r8
539 :
540 1958400 : do ispec = 1, aero_props%nspecies(list_idx,bin_idx)
541 1766400 : call self%get_ambient_mmr(list_idx, ispec, bin_idx, mmr)
542 1766400 : call aero_props%get(bin_idx, ispec, list_ndx=list_idx, density=specdens)
543 872440320 : vol(:ncol,:) = vol(:ncol,:) + mmr(:ncol,:)/specdens
544 : end do
545 :
546 960000 : end function dry_volume
547 :
548 : !------------------------------------------------------------------------------
549 : ! aerosol wet volume (m3/kg) for given radiation diagnostic list number and bin number
550 : !------------------------------------------------------------------------------
551 768000 : function wet_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
552 :
553 : class(modal_aerosol_state), intent(in) :: self
554 : class(aerosol_properties), intent(in) :: aero_props
555 :
556 : integer, intent(in) :: list_idx ! rad climate/diags list number
557 : integer, intent(in) :: bin_idx ! bin number
558 : integer, intent(in) :: ncol ! number of columns
559 : integer, intent(in) :: nlev ! number of levels
560 :
561 : real(r8) :: vol(ncol,nlev) ! m3/kg
562 :
563 192000 : real(r8) :: dryvol(ncol,nlev)
564 384000 : real(r8) :: watervol(ncol,nlev)
565 :
566 94809600 : dryvol = self%dry_volume(aero_props, list_idx, bin_idx, ncol, nlev)
567 94809600 : watervol = self%water_volume(aero_props, list_idx, bin_idx, ncol, nlev)
568 :
569 94809600 : vol = watervol + dryvol
570 :
571 192000 : end function wet_volume
572 :
573 : !------------------------------------------------------------------------------
574 : ! aerosol water volume (m3/kg) for given radiation diagnostic list number and bin number
575 : !------------------------------------------------------------------------------
576 1536000 : function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol)
577 :
578 : class(modal_aerosol_state), intent(in) :: self
579 : class(aerosol_properties), intent(in) :: aero_props
580 :
581 : integer, intent(in) :: list_idx ! rad climate/diags list number
582 : integer, intent(in) :: bin_idx ! bin number
583 : integer, intent(in) :: ncol ! number of columns
584 : integer, intent(in) :: nlev ! number of levels
585 :
586 : real(r8) :: vol(ncol,nlev) ! m3/kg
587 :
588 768000 : real(r8) :: dgnumwet(ncol,nlev)
589 384000 : real(r8) :: qaerwat(ncol,nlev)
590 :
591 384000 : call self%water_uptake(aero_props, list_idx, bin_idx, ncol, nlev, dgnumwet, qaerwat)
592 :
593 189619200 : vol(:ncol,:nlev) = qaerwat(:ncol,:nlev)*rh2odens
594 189619200 : where (vol<0._r8)
595 : vol = 0._r8
596 : end where
597 :
598 384000 : end function water_volume
599 :
600 : !------------------------------------------------------------------------------
601 : ! aerosol wet diameter
602 : !------------------------------------------------------------------------------
603 3225600 : function wet_diameter(self, bin_idx, ncol, nlev) result(diam)
604 : class(modal_aerosol_state), intent(in) :: self
605 : integer, intent(in) :: bin_idx ! bin number
606 : integer, intent(in) :: ncol ! number of columns
607 : integer, intent(in) :: nlev ! number of levels
608 :
609 : real(r8) :: diam(ncol,nlev)
610 :
611 806400 : real(r8), pointer :: dgnumwet(:,:,:)
612 :
613 806400 : call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet)
614 :
615 398200320 : diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx)
616 :
617 806400 : end function wet_diameter
618 :
619 : !------------------------------------------------------------------------------
620 : ! prescribed aerosol activation fraction for convective cloud
621 : !------------------------------------------------------------------------------
622 4112640 : function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac)
623 :
624 : use modal_aero_data
625 :
626 : class(modal_aerosol_state), intent(in) :: self
627 : integer, intent(in) :: ibin ! bin index
628 : integer, intent(in) :: ispc ! species index
629 : integer, intent(in) :: ncol ! number of columns
630 : integer, intent(in) :: nlev ! number of vertical levels
631 :
632 : real(r8) :: frac(ncol,nlev)
633 :
634 4112640 : real(r8) :: f_act_conv_coarse(ncol,nlev)
635 : real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl
636 : real(r8) :: tmpdust, tmpnacl
637 : integer :: lcoardust, lcoarnacl
638 : integer :: i,k
639 :
640 2030821632 : f_act_conv_coarse(:,:) = 0.60_r8
641 4112640 : f_act_conv_coarse_dust = 0.40_r8
642 4112640 : f_act_conv_coarse_nacl = 0.80_r8
643 4112640 : if (modeptr_coarse > 0) then
644 4112640 : lcoardust = lptr_dust_a_amode(modeptr_coarse)
645 4112640 : lcoarnacl = lptr_nacl_a_amode(modeptr_coarse)
646 4112640 : if ((lcoardust > 0) .and. (lcoarnacl > 0)) then
647 135717120 : do k = 1, nlev
648 2030821632 : do i = 1, ncol
649 1895104512 : tmpdust = max( 0.0_r8, self%state%q(i,k,lcoardust) )
650 1895104512 : tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) )
651 2026708992 : if ((tmpdust+tmpnacl) > 1.0e-30_r8) then
652 1895104512 : f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust &
653 1895104512 : + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl)
654 : end if
655 : end do
656 : end do
657 : end if
658 : end if
659 :
660 4112640 : if (ibin == modeptr_pcarbon) then
661 159280128 : frac = 0.0_r8
662 3790080 : else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then
663 0 : frac = 0.4_r8
664 : else
665 1871541504 : frac = 0.8_r8
666 : end if
667 :
668 : ! set f_act_conv for interstitial (lphase=1) coarse mode species
669 : ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt
670 : ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt
671 : ! number and sulfate are conceptually partitioned to the dust and seasalt
672 : ! on a mass basis, so the f_act_conv for number and sulfate are
673 : ! mass-weighted averages of the values used for dust/seasalt
674 4112640 : if (ibin == modeptr_coarse) then
675 159280128 : frac = f_act_conv_coarse
676 322560 : if (ispc>0) then
677 241920 : if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then
678 39820032 : frac = f_act_conv_coarse_dust
679 161280 : else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then
680 39820032 : frac = f_act_conv_coarse_nacl
681 : end if
682 : end if
683 : end if
684 :
685 8225280 : end function convcld_actfrac
686 :
687 : !------------------------------------------------------------------------------
688 : ! aerosol weight precent of H2SO4/H2O solution
689 : !------------------------------------------------------------------------------
690 153600 : function wgtpct(self, ncol, nlev) result(wtp)
691 : class(modal_aerosol_state), intent(in) :: self
692 : integer, intent(in) :: ncol, nlev
693 : real(r8) :: wtp(ncol,nlev) ! weight precent of H2SO4/H2O solution for given icol, ilev
694 :
695 37923840 : wtp(:,:) = -huge(1._r8)
696 :
697 4189440 : end function wgtpct
698 :
699 407040 : end module modal_aerosol_state_mod
|
