Line data Source code
1 : !! The CARMAGROUP module contains configuration information about a CARMA partcile.
2 : !!
3 : !! NOTE: Because of the way Fortran handles pointers and allocations, it is much
4 : !! simpiler to have these methods directly access the group array that is in the
5 : !! CARMA object rather than having this as its own objects. Some compilers (like
6 : !! IBM on AIX do not by default automatically deallocate automatically created
7 : !! derived types that contain allocations. This can result in memory leaks that
8 : !! are difficult to find.
9 : !!
10 : !! These calls are written like they are part of CARMA, but they are called
11 : !! CARMAGROUP and kept by themselves in their own file to make it easier to keep
12 : !! track of what is required when adding an attribute to a group.
13 : !!
14 : !! @version July-2009
15 : !! @author Chuck Bardeen
16 : module carmagroup_mod
17 :
18 : use carma_precision_mod
19 : use carma_enums_mod
20 : use carma_constants_mod
21 : use carma_types_mod
22 :
23 : ! CARMA explicitly declares all variables.
24 : implicit none
25 :
26 : ! All CARMA variables and procedures are private except those explicitly declared to be public.
27 : private
28 :
29 : ! Declare the public methods.
30 : public CARMAGROUP_Create
31 : public CARMAGROUP_Destroy
32 : public CARMAGROUP_Get
33 : public CARMAGROUP_Print
34 :
35 : contains
36 :
37 3072 : subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, is_ice, rc, is_fractal, &
38 : irhswell, irhswcomp, do_mie, do_wetdep, do_drydep, do_vtran, solfac, scavcoef, shortname, &
39 : cnsttype, maxbin, ifallrtn, is_cloud, rmassmin, imiertn, iopticstype, is_sulfate, dpc_threshold, &
40 0 : rmon, df, falpha, neutral_volfrc)
41 : type(carma_type), intent(inout) :: carma !! the carma object
42 : integer, intent(in) :: igroup !! the group index
43 : character(*), intent(in) :: name !! the group name, maximum of 255 characters
44 : real(kind=f), intent(in) :: rmin !! the minimum radius, can be specified [cm]
45 : real(kind=f), intent(in) :: rmrat !! the volume ratio between bins
46 : integer, intent(in) :: ishape !! the type of the particle shape
47 : !! [I_SPHERE | I_HEXAGON | I_CYLINDER]
48 : real(kind=f), intent(in) :: eshape !! the aspect ratio of the particle shape (length/diameter)
49 : logical, intent(in) :: is_ice !! is this an ice particle?
50 : integer, intent(out) :: rc !! return code, negative indicates failure
51 : logical, optional, intent(in) :: is_fractal !! is this a fractal particle?
52 : integer, optional, intent(in) :: irhswell !! the parameterization for particle swelling from relative humidity
53 : !! [I_FITZGERALD | I_GERBER | I_WTPCT_H2SO4 | I_PETTERS]
54 : integer, optional, intent(in) :: irhswcomp !! the composition for particle swelling from relative humidity
55 : !! [I_SWG_NH42SO4 | I_SWG_SEA_SALT | I_SWG_URBAN | I_SWG_RURAL]
56 : logical, optional, intent(in) :: do_mie !! do mie calculations?
57 : logical, optional, intent(in) :: do_wetdep !! do wet deposition for this particle?
58 : logical, optional, intent(in) :: do_drydep !! do dry deposition for this particle?
59 : logical, optional, intent(in) :: do_vtran !! do sedimentation for this particle?
60 : real(kind=f), intent(in), optional :: solfac !! the solubility factor for wet deposition
61 : real(kind=f), intent(in), optional :: scavcoef !! the scavenging coefficient for wet deposition
62 : character(*), optional, intent(in) :: shortname !! the group shortname, maximum of 6 characters
63 : integer, optional, intent(in) :: cnsttype !! constituent type in parent model
64 : !! [I_CNSTTYPE_PROGNOSTIC | I_CNSTTYPE_DIAGNOSTIC]
65 : integer, optional, intent(in) :: maxbin !! bin number of the last prognostic bin
66 : !! the remaining bins are diagnostic
67 : integer, optional, intent(in) :: ifallrtn !! fall velocity routine [I_FALLRTN_STD
68 : !! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
69 : !! | I_FALLRTN_ACKERMAN_DROP | I_FALLRTN_ACKERMAN_ICE]
70 : logical, optional, intent(in) :: is_cloud !! is this a cloud particle?
71 : real(kind=f), optional, intent(in) :: rmassmin !! the minimum mass, when used overrides rmin[g]
72 : integer, optional, intent(in) :: imiertn !! mie routine [I_MIERTN_TOON1981 | I_MIERTN_BOHREN1983
73 : !! | I_MIERTN_BOTET1997]
74 : integer, optional, intent(in) :: iopticstype !! optics routine [I_OPTICS_FIXED | I_OPTICS_MIXED_YU2015
75 : !! | I_OPTICS_SULFATE_YU2015 | I_OPTICS_MIXED_CORESHELL
76 : !! | I_OPTICS_MIXED_VOLUME | I_OPTICS_MIXED_MAXWELL
77 : !! | I_OPTICS_SULFATE ]
78 : logical, optional, intent(in) :: is_sulfate !! is this a sulfate particle?
79 : real(kind=f), optional, intent(in) :: dpc_threshold !! convergence criteria for particle concentration
80 : !! [fraction]
81 : real(kind=f), optional, intent(in) :: rmon !! monomer radius for fractal particles [cm]
82 : real(kind=f), optional, intent(in) :: df(carma%f_NBIN) !! fractal dimension
83 : real(kind=f), optional, intent(in) :: falpha !! fractal packing coefficient
84 : real(kind=f), optional, intent(in) :: neutral_volfrc !! volume fraction of core mass for neutralization
85 :
86 : ! Local variables
87 : integer :: ier
88 :
89 : ! Assume success.
90 3072 : rc = RC_OK
91 :
92 : ! Make sure there are enough groups allocated.
93 3072 : if (igroup > carma%f_NGROUP) then
94 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add:: ERROR - The specifed group (", &
95 0 : igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
96 0 : rc = RC_ERROR
97 0 : return
98 : end if
99 :
100 : allocate( &
101 0 : carma%f_group(igroup)%f_r(carma%f_NBIN), &
102 0 : carma%f_group(igroup)%f_rmass(carma%f_NBIN), &
103 0 : carma%f_group(igroup)%f_vol(carma%f_NBIN), &
104 0 : carma%f_group(igroup)%f_dr(carma%f_NBIN), &
105 0 : carma%f_group(igroup)%f_dm(carma%f_NBIN), &
106 0 : carma%f_group(igroup)%f_rmassup(carma%f_NBIN), &
107 0 : carma%f_group(igroup)%f_rup(carma%f_NBIN), &
108 0 : carma%f_group(igroup)%f_rlow(carma%f_NBIN), &
109 0 : carma%f_group(igroup)%f_icorelem(carma%f_NELEM), &
110 0 : carma%f_group(igroup)%f_arat(carma%f_NBIN), &
111 0 : carma%f_group(igroup)%f_rrat(carma%f_NBIN), &
112 0 : carma%f_group(igroup)%f_rprat(carma%f_NBIN), &
113 0 : carma%f_group(igroup)%f_df(carma%f_NBIN), &
114 0 : carma%f_group(igroup)%f_nmon(carma%f_NBIN), &
115 89088 : stat=ier)
116 3072 : if(ier /= 0) then
117 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add: ERROR allocating, status=", ier
118 0 : rc = RC_ERROR
119 0 : return
120 : end if
121 :
122 : ! Initialize
123 64512 : carma%f_group(igroup)%f_r(:) = 0._f
124 64512 : carma%f_group(igroup)%f_rmass(:) = 0._f
125 64512 : carma%f_group(igroup)%f_vol(:) = 0._f
126 64512 : carma%f_group(igroup)%f_dr(:) = 0._f
127 64512 : carma%f_group(igroup)%f_dm(:) = 0._f
128 64512 : carma%f_group(igroup)%f_rmassup(:) = 0._f
129 64512 : carma%f_group(igroup)%f_rup(:) = 0._f
130 64512 : carma%f_group(igroup)%f_rlow(:) = 0._f
131 24576 : carma%f_group(igroup)%f_icorelem(:) = 0
132 3072 : carma%f_group(igroup)%f_ifallrtn = I_FALLRTN_STD
133 3072 : carma%f_group(igroup)%f_imiertn = I_MIERTN_TOON1981
134 3072 : carma%f_group(igroup)%f_iopticstype = I_OPTICS_FIXED
135 3072 : carma%f_group(igroup)%f_is_fractal = .false.
136 3072 : carma%f_group(igroup)%f_is_cloud = .false.
137 3072 : carma%f_group(igroup)%f_is_sulfate = .false.
138 3072 : carma%f_group(igroup)%f_dpc_threshold = 0._f
139 3072 : carma%f_group(igroup)%f_rmon = 0._f
140 64512 : carma%f_group(igroup)%f_df(:) = 3.0_f
141 64512 : carma%f_group(igroup)%f_nmon(:) = 1.0_f
142 3072 : carma%f_group(igroup)%f_falpha = 1.0_f
143 3072 : carma%f_group(igroup)%f_neutral_volfrc = 0.0_f
144 :
145 : ! Any optical properties?
146 3072 : if (carma%f_NWAVE > 0) then
147 : allocate( &
148 0 : carma%f_group(igroup)%f_qext(carma%f_NWAVE,carma%f_NBIN), &
149 0 : carma%f_group(igroup)%f_ssa(carma%f_NWAVE,carma%f_NBIN), &
150 0 : carma%f_group(igroup)%f_asym(carma%f_NWAVE,carma%f_NBIN), &
151 30720 : stat=ier)
152 3072 : if(ier /= 0) then
153 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add: ERROR allocating, status=", ier
154 0 : rc = RC_ERROR
155 0 : return
156 : endif
157 :
158 : ! Initialize
159 1907712 : carma%f_group(igroup)%f_qext(:,:) = 0._f
160 1907712 : carma%f_group(igroup)%f_ssa(:,:) = 0._f
161 1907712 : carma%f_group(igroup)%f_asym(:,:) = 0._f
162 : end if
163 :
164 :
165 : ! Save off the settings.
166 3072 : carma%f_group(igroup)%f_name = name
167 3072 : carma%f_group(igroup)%f_rmin = rmin
168 3072 : carma%f_group(igroup)%f_rmrat = rmrat
169 3072 : carma%f_group(igroup)%f_ishape = ishape
170 3072 : carma%f_group(igroup)%f_eshape = eshape
171 3072 : carma%f_group(igroup)%f_is_ice = is_ice
172 :
173 :
174 : ! Defaults for optional parameters
175 3072 : carma%f_group(igroup)%f_irhswell = 0
176 3072 : carma%f_group(igroup)%f_do_mie = .false.
177 3072 : carma%f_group(igroup)%f_do_wetdep = .false.
178 3072 : carma%f_group(igroup)%f_grp_do_drydep = .false.
179 3072 : carma%f_group(igroup)%f_grp_do_vtran = .true.
180 3072 : carma%f_group(igroup)%f_solfac = 0.3_f
181 3072 : carma%f_group(igroup)%f_scavcoef = 0.1_f
182 3072 : carma%f_group(igroup)%f_shortname = ""
183 3072 : carma%f_group(igroup)%f_cnsttype = I_CNSTTYPE_PROGNOSTIC
184 3072 : carma%f_group(igroup)%f_maxbin = carma%f_NBIN
185 3072 : carma%f_group(igroup)%f_rmassmin = 0.0_f
186 :
187 : ! Set optional parameters.
188 3072 : if (present(irhswell)) carma%f_group(igroup)%f_irhswell = irhswell
189 3072 : if (present(irhswcomp)) carma%f_group(igroup)%f_irhswcomp = irhswcomp
190 3072 : if (present(do_mie)) carma%f_group(igroup)%f_do_mie = do_mie
191 3072 : if (present(do_wetdep)) carma%f_group(igroup)%f_do_wetdep = do_wetdep
192 3072 : if (present(do_drydep)) carma%f_group(igroup)%f_grp_do_drydep = do_drydep
193 3072 : if (present(do_vtran)) carma%f_group(igroup)%f_grp_do_vtran = do_vtran
194 3072 : if (present(solfac)) carma%f_group(igroup)%f_solfac = solfac
195 3072 : if (present(scavcoef)) carma%f_group(igroup)%f_scavcoef = scavcoef
196 3072 : if (present(shortname)) carma%f_group(igroup)%f_shortname = shortname
197 3072 : if (present(cnsttype)) carma%f_group(igroup)%f_cnsttype = cnsttype
198 3072 : if (present(maxbin)) carma%f_group(igroup)%f_maxbin = maxbin
199 3072 : if (present(ifallrtn)) carma%f_group(igroup)%f_ifallrtn = ifallrtn
200 3072 : if (present(is_cloud)) carma%f_group(igroup)%f_is_cloud = is_cloud
201 3072 : if (present(is_fractal)) carma%f_group(igroup)%f_is_fractal = is_fractal
202 3072 : if (present(rmassmin)) carma%f_group(igroup)%f_rmassmin = rmassmin
203 3072 : if (present(imiertn)) carma%f_group(igroup)%f_imiertn = imiertn
204 3072 : if (present(iopticstype)) carma%f_group(igroup)%f_iopticstype = iopticstype
205 3072 : if (present(is_sulfate)) carma%f_group(igroup)%f_is_sulfate = is_sulfate
206 3072 : if (present(dpc_threshold)) carma%f_group(igroup)%f_dpc_threshold = dpc_threshold
207 3072 : if (present(rmon)) carma%f_group(igroup)%f_rmon = rmon
208 3072 : if (present(df)) carma%f_group(igroup)%f_df(:) = df(:)
209 3072 : if (present(falpha)) carma%f_group(igroup)%f_falpha = falpha
210 3072 : if (present(neutral_volfrc)) carma%f_group(igroup)%f_neutral_volfrc = neutral_volfrc
211 :
212 : ! Initialize other properties.
213 3072 : carma%f_group(igroup)%f_nelem = 0
214 3072 : carma%f_group(igroup)%f_if_sec_mom = .FALSE.
215 3072 : carma%f_group(igroup)%f_ncore = 0
216 3072 : carma%f_group(igroup)%f_ienconc = 0
217 3072 : carma%f_group(igroup)%f_imomelem = 0
218 :
219 :
220 : ! The area ratio is the ratio of the area of the shape to the area of the
221 : ! circumscribing circle. The radius ratio is the ratio between the radius
222 : ! of the longest dimension and the radius of the enclosing sphere.
223 3072 : if (ishape .eq. I_HEXAGON) then
224 0 : carma%f_group(igroup)%f_arat(:) = 3._f * sqrt(3._f) / 2._f / PI
225 0 : carma%f_group(igroup)%f_rrat(:) = ((4._f * PI / 9._f / sqrt(3._f)) ** (1._f / 3._f)) * eshape**(-1._f / 3._f)
226 3072 : else if (ishape .eq. I_CYLINDER) then
227 0 : carma%f_group(igroup)%f_arat(:) = 1.0_f
228 0 : carma%f_group(igroup)%f_rrat(:) = ((2._f / 3._f) ** (1._f / 3._f)) * eshape**(-1._f / 3._f)
229 : else
230 :
231 : ! Default to a sphere.
232 : !
233 : ! NOTE: Should add code here to handle oblate and prolate spheroids.
234 64512 : carma%f_group(igroup)%f_arat(:) = 1.0_f
235 64512 : carma%f_group(igroup)%f_rrat(:) = 1.0_f
236 : end if
237 :
238 64512 : carma%f_group(igroup)%f_rprat(:) = 1.0_f
239 :
240 : !! Dry fractal aggregate aerosols composed of nmon identical spheres of radius rmon
241 : !! can be treated by enabling the switch is_fractal = .true. Optical properties of dry
242 : !! fractal aggregates can be computed using option imiertn = I_MIERTN_FRACTAL.
243 : !! To use either of these options, the user must define the fractal dimension, df(NBIN),
244 : !! monomer size (rmon), and packing coefficient (falpha) when creating the CARMA group.
245 : !!
246 : !! For aerosol particles fractal dimensions (df) are typically near 2.0, but can vary as a function
247 : !! of size/number of monomers contained withing. The packing coefficient (falpha) is expected to be near
248 : !! unity. falpha > 1 implies a more tightly packed fractal aggregate and vice-versa.
249 : !!
250 : !! If the user desires to use fractal optical properties calculation (I_MIERTN_BOTET1997), then
251 : !! the user must also have fractal microphysics enabled (is_fractal = .true.). However, note that
252 : !! if fractal microphysics are enabled, the user is free to select a standard Mie optical property calculation.
253 : !!
254 : !
255 : ! Check consistency for fractal optical property calculation
256 3072 : if ((carma%f_group(igroup)%f_imiertn == I_MIERTN_BOTET1997) .and. &
257 : .not. carma%f_group(igroup)%f_is_fractal) then
258 0 : if (carma%f_do_print) then
259 : write(carma%f_LUNOPRT, *) "CARMAGROUP_Create:&
260 0 : &ERROR, fractal optics selected without fractal microphysics enabled."
261 : end if
262 0 : rc = RC_ERROR
263 0 : return
264 : end if
265 :
266 : ! Check input consistency for fractal physics
267 3072 : if (carma%f_group(igroup)%f_is_fractal .or. &
268 : (carma%f_group(igroup)%f_imiertn == I_MIERTN_BOTET1997)) then
269 0 : if (.not. (present(rmon) .and. present(df) .and. present(falpha))) then
270 0 : if (carma%f_do_print) then
271 : write(carma%f_LUNOPRT, *) "CARMAGROUP_Create:&
272 0 : &ERROR, for fractal physics must set rmon,df,falpha"
273 : end if
274 0 : rc = RC_ERROR
275 0 : return
276 : end if
277 : end if
278 :
279 : return
280 3072 : end subroutine CARMAGROUP_Create
281 :
282 :
283 : !! Deallocates the memory associated with a CARMAGROUP object.
284 : !!
285 : !! @author Chuck Bardeen
286 : !! @version May-2009
287 : !!
288 : !! @see CARMAGROUP_Create
289 3072 : subroutine CARMAGROUP_Destroy(carma, igroup, rc)
290 : type(carma_type), intent(inout) :: carma !! the carma object
291 : integer, intent(in) :: igroup !! the group index
292 : integer, intent(out) :: rc !! return code, negative indicates failure
293 :
294 : ! Local variables
295 : integer :: ier
296 :
297 : ! Assume success.
298 3072 : rc = RC_OK
299 :
300 : ! Make sure there are enough groups allocated.
301 3072 : if (igroup > carma%f_NGROUP) then
302 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy:: ERROR - The specifed group (", &
303 0 : igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
304 0 : rc = RC_ERROR
305 0 : return
306 : end if
307 :
308 3072 : if (allocated(carma%f_group(igroup)%f_qext)) then
309 : deallocate( &
310 : carma%f_group(igroup)%f_qext, &
311 0 : carma%f_group(igroup)%f_ssa, &
312 0 : carma%f_group(igroup)%f_asym, &
313 3072 : stat=ier)
314 3072 : if(ier /= 0) then
315 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy: ERROR deallocating, status=", ier
316 0 : rc = RC_ERROR
317 0 : return
318 : endif
319 : endif
320 :
321 : ! Allocate dynamic data.
322 3072 : if (allocated(carma%f_group(igroup)%f_r)) then
323 : deallocate( &
324 : carma%f_group(igroup)%f_r, &
325 0 : carma%f_group(igroup)%f_rmass, &
326 0 : carma%f_group(igroup)%f_vol, &
327 0 : carma%f_group(igroup)%f_dr, &
328 0 : carma%f_group(igroup)%f_dm, &
329 0 : carma%f_group(igroup)%f_rmassup, &
330 0 : carma%f_group(igroup)%f_rup, &
331 0 : carma%f_group(igroup)%f_rlow, &
332 0 : carma%f_group(igroup)%f_icorelem, &
333 0 : carma%f_group(igroup)%f_arat, &
334 0 : carma%f_group(igroup)%f_rrat, &
335 0 : carma%f_group(igroup)%f_rprat, &
336 0 : carma%f_group(igroup)%f_df, &
337 0 : carma%f_group(igroup)%f_nmon, &
338 3072 : stat=ier)
339 3072 : if(ier /= 0) then
340 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy: ERROR deallocating, status=", ier
341 0 : rc = RC_ERROR
342 0 : return
343 : endif
344 : endif
345 :
346 : return
347 : end subroutine CARMAGROUP_Destroy
348 :
349 :
350 : !! Gets information about a group.
351 : !!
352 : !! The group name and most other properties are available after a call to
353 : !! CARMAGROUP_Create(). After a call to CARMA_Initialize(), the bin
354 : !! dimensions and optical properties can be retrieved.
355 : !!
356 : !! @author Chuck Bardeen
357 : !! @version May-2009
358 : !!
359 : !! @see CARMAGROUP_Create
360 : !! @see CARMA_GetGroup
361 : !! @see CARMA_Initialize
362 23246914315 : subroutine CARMAGROUP_Get(carma, igroup, rc, name, shortname, rmin, rmrat, ishape, eshape, is_ice, is_fractal, &
363 2373580025 : irhswell, irhswcomp, cnsttype, r, rlow, rup, dr, rmass, dm, vol, qext, ssa, asym, do_mie, &
364 17261034103 : do_wetdep, do_drydep, do_vtran, solfac, scavcoef, ienconc, ncore, icorelem, maxbin, &
365 14708736 : ifallrtn, is_cloud, rmassmin, arat, rrat, rprat, imiertn, iopticstype, is_sulfate, dpc_threshold, rmon, df, &
366 0 : nmon, falpha, neutral_volfrc)
367 :
368 : type(carma_type), intent(in) :: carma !! the carma object
369 : integer, intent(in) :: igroup !! the group index
370 : integer, intent(out) :: rc !! return code, negative indicates failure
371 : character(len=*), optional, intent(out) :: name !! the group name
372 : character(len=*), optional, intent(out) :: shortname !! the group short name
373 : real(kind=f), optional, intent(out) :: rmin !! the minimum radius [cm]
374 : real(kind=f), optional, intent(out) :: rmrat !! the volume ratio between bins
375 : integer, optional, intent(out) :: ishape !! the type of the particle shape
376 : real(kind=f), optional, intent(out) :: eshape !! the aspect ratio of the particle shape
377 : logical, optional, intent(out) :: is_ice !! is this an ice particle?
378 : logical, optional, intent(out) :: is_fractal !! is this a fractal?
379 : integer, optional, intent(out) :: irhswell !! the parameterization for particle swelling
380 : !! from relative humidity
381 : integer, optional, intent(out) :: irhswcomp !! the composition for particle swelling
382 : !! from relative humidity
383 : integer, optional, intent(out) :: cnsttype !! constituent type in the parent model
384 : real(kind=f), intent(out), optional :: r(carma%f_NBIN) !! the bin radius [cm]
385 : real(kind=f), intent(out), optional :: rlow(carma%f_NBIN) !! the bin radius lower bound [cm]
386 : real(kind=f), intent(out), optional :: rup(carma%f_NBIN) !! the bin radius upper bound [cm]
387 : real(kind=f), intent(out), optional :: dr(carma%f_NBIN) !! the bin width in radius space [cm]
388 : real(kind=f), intent(out), optional :: rmass(carma%f_NBIN) !! the bin mass [g]
389 : real(kind=f), intent(out), optional :: dm(carma%f_NBIN) !! the bin width in mass space [g]
390 : real(kind=f), intent(out), optional :: vol(carma%f_NBIN) !! the bin volume [cm<sup>3</sup>]
391 : real(kind=f), intent(out), optional :: arat(carma%f_NBIN) !! the projected area ratio
392 : !! (area / area enclosing sphere)
393 : real(kind=f), intent(out), optional :: rrat(carma%f_NBIN) !! the radius ratio
394 : !! (maximum dimension / radius of enclosing sphere)
395 : real(kind=f), intent(out), optional :: rprat(carma%f_NBIN) !! the porusity radius ratio
396 : !! (scaled porosity radius / equiv. sphere)
397 : real(kind=f), intent(out), optional :: qext(carma%f_NWAVE,carma%f_NBIN) !! extinction efficiency
398 : real(kind=f), intent(out), optional :: ssa(carma%f_NWAVE,carma%f_NBIN) !! single scattering albedo
399 : real(kind=f), intent(out), optional :: asym(carma%f_NWAVE,carma%f_NBIN) !! asymmetry factor
400 : logical, optional, intent(out) :: do_mie !! do mie calculations?
401 : logical, optional, intent(out) :: do_wetdep !! do wet deposition for this particle?
402 : logical, optional, intent(out) :: do_drydep !! do dry deposition for this particle?
403 : logical, optional, intent(out) :: do_vtran !! do sedimentation for this particle?
404 : real(kind=f), intent(out), optional :: solfac !! the solubility factor for wet deposition
405 : real(kind=f), intent(out), optional :: scavcoef !! the scavenging coefficient for wet deposition
406 : integer, intent(out), optional :: ienconc !! Particle number conc. element for group
407 : integer, intent(out), optional :: ncore !! Number of core mass elements for group
408 : integer, intent(out), optional :: icorelem(carma%f_NELEM) !! Element index of core mass elements for group
409 : integer, optional, intent(out) :: maxbin !! the last prognostic bin in the group
410 : integer, optional, intent(out) :: ifallrtn !! fall velocity routine [I_FALLRTN_STD
411 : !! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
412 : !! | I_FALLRTN_ACKERMAN_DROP
413 : !! | I_FALLRTN_ACKERMAN_ICE]
414 : logical, optional, intent(out) :: is_cloud !! is this a cloud particle?
415 : real(kind=f), optional, intent(out) :: rmassmin !! the minimum mass [g]
416 : integer, optional, intent(out) :: imiertn !! mie routine [I_MIERTN_TOON1981
417 : !! | I_MIERTN_BOHREN1983 | I_MIERTN_BOTET1997]
418 : integer, optional, intent(out) :: iopticstype !! optics routine [I_OPTICS_FIXED | I_OPTICS_MIXED_YU2015
419 : !! | I_OPTICS_SULFATE_YU2015 | I_OPTICS_MIXED_CORESHELL
420 : !! | I_OPTICS_MIXED_VOLUME | I_OPTICS_MIXED_MAXWELL
421 : !! | I_OPTICS_SULFATE ]
422 : logical, optional, intent(out) :: is_sulfate !! is this a sulfate particle?
423 : real(kind=f), optional, intent(out) :: dpc_threshold !! convergence criteria for particle concentration
424 : !! [fraction]
425 : real(kind=f), optional, intent(out) :: rmon !! monomer radius for fractal particles
426 : real(kind=f), optional, intent(out) :: df(carma%f_NBIN) !! fractal dimension
427 : real(kind=f), optional, intent(out) :: nmon(carma%f_NBIN) !! number of monomers per
428 : real(kind=f), optional, intent(out) :: falpha !! fractal packing coefficient
429 : real(kind=f), optional, intent(out) :: neutral_volfrc !! volume fraction of core mass for neutralization
430 :
431 : ! Assume success.
432 23246914315 : rc = RC_OK
433 :
434 : ! Make sure there are enough groups allocated.
435 23246914315 : if (igroup > carma%f_NGROUP) then
436 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get:: ERROR - The specifed group (", &
437 0 : igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
438 0 : rc = RC_ERROR
439 0 : return
440 : end if
441 :
442 : ! Return any requested properties of the group.
443 23246914315 : if (present(name)) name = carma%f_group(igroup)%f_name
444 23246914315 : if (present(shortname)) shortname = carma%f_group(igroup)%f_shortname
445 23246914315 : if (present(rmin)) rmin = carma%f_group(igroup)%f_rmin
446 23246914315 : if (present(rmrat)) rmrat = carma%f_group(igroup)%f_rmrat
447 23246914315 : if (present(ishape)) ishape = carma%f_group(igroup)%f_ishape
448 23246914315 : if (present(eshape)) eshape = carma%f_group(igroup)%f_eshape
449 23246914315 : if (present(is_ice)) is_ice = carma%f_group(igroup)%f_is_ice
450 23246914315 : if (present(is_fractal)) is_fractal = carma%f_group(igroup)%f_is_fractal
451 23246914315 : if (present(irhswell)) irhswell = carma%f_group(igroup)%f_irhswell
452 23246914315 : if (present(irhswcomp)) irhswcomp = carma%f_group(igroup)%f_irhswcomp
453 23246914315 : if (present(cnsttype)) cnsttype = carma%f_group(igroup)%f_cnsttype
454 23394247435 : if (present(r)) r(:) = carma%f_group(igroup)%f_r(:)
455 23246914315 : if (present(rlow)) rlow(:) = carma%f_group(igroup)%f_rlow(:)
456 23246914315 : if (present(rup)) rup(:) = carma%f_group(igroup)%f_rup(:)
457 23246945035 : if (present(dr)) dr(:) = carma%f_group(igroup)%f_dr(:)
458 70571150975 : if (present(rmass)) rmass(:) = carma%f_group(igroup)%f_rmass(:)
459 23394001675 : if (present(rrat)) rrat(:) = carma%f_group(igroup)%f_rrat(:)
460 23394001675 : if (present(arat)) arat(:) = carma%f_group(igroup)%f_arat(:)
461 23246914315 : if (present(rprat)) rprat(:) = carma%f_group(igroup)%f_rprat(:)
462 23246914315 : if (present(dm)) dm(:) = carma%f_group(igroup)%f_dm(:)
463 23246914315 : if (present(vol)) vol(:) = carma%f_group(igroup)%f_vol(:)
464 23246914315 : if (present(do_mie)) do_mie = carma%f_group(igroup)%f_do_mie
465 23246914315 : if (present(do_wetdep)) do_wetdep = carma%f_group(igroup)%f_do_wetdep
466 23246914315 : if (present(do_drydep)) do_drydep = carma%f_group(igroup)%f_grp_do_drydep
467 23246914315 : if (present(do_vtran)) do_vtran = carma%f_group(igroup)%f_grp_do_vtran
468 23246914315 : if (present(solfac)) solfac = carma%f_group(igroup)%f_solfac
469 23246914315 : if (present(scavcoef)) scavcoef = carma%f_group(igroup)%f_scavcoef
470 23246914315 : if (present(ienconc)) ienconc = carma%f_group(igroup)%f_ienconc
471 23246914315 : if (present(ncore)) ncore = carma%f_group(igroup)%f_ncore
472 >14407*10^7 : if (present(icorelem)) icorelem = carma%f_group(igroup)%f_icorelem(:)
473 23246914315 : if (present(maxbin)) maxbin = carma%f_group(igroup)%f_maxbin
474 23246914315 : if (present(ifallrtn)) ifallrtn = carma%f_group(igroup)%f_ifallrtn
475 23246914315 : if (present(is_cloud)) is_cloud = carma%f_group(igroup)%f_is_cloud
476 23246914315 : if (present(rmassmin)) rmassmin = carma%f_group(igroup)%f_rmassmin
477 23246914315 : if (present(imiertn)) imiertn = carma%f_group(igroup)%f_imiertn
478 23246914315 : if (present(iopticstype)) iopticstype = carma%f_group(igroup)%f_iopticstype
479 23246914315 : if (present(is_sulfate)) is_sulfate = carma%f_group(igroup)%f_is_sulfate
480 23246914315 : if (present(dpc_threshold)) dpc_threshold = carma%f_group(igroup)%f_dpc_threshold
481 23246914315 : if (present(rmon)) rmon = carma%f_group(igroup)%f_rmon
482 23246914315 : if (present(df)) df(:) = carma%f_group(igroup)%f_df(:)
483 23246914315 : if (present(nmon)) nmon(:) = carma%f_group(igroup)%f_nmon(:)
484 23246914315 : if (present(falpha)) falpha = carma%f_group(igroup)%f_falpha
485 23246914315 : if (present(neutral_volfrc)) neutral_volfrc = carma%f_group(igroup)%f_neutral_volfrc
486 :
487 23246914315 : if (carma%f_NWAVE == 0) then
488 0 : if (present(qext) .or. present(ssa) .or. present(asym)) then
489 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get: ERROR no optical properties defined."
490 0 : rc = RC_ERROR
491 0 : return
492 : end if
493 : else
494 23246914315 : if (present(qext)) qext(:,:) = carma%f_group(igroup)%f_qext(:,:)
495 23246914315 : if (present(ssa)) ssa(:,:) = carma%f_group(igroup)%f_ssa(:,:)
496 23246914315 : if (present(asym)) asym(:,:) = carma%f_group(igroup)%f_asym(:,:)
497 : end if
498 :
499 : return
500 42896237179 : end subroutine CARMAGROUP_Get
501 :
502 :
503 :
504 : !! Prints information about a group.
505 : !!
506 : !! @author Chuck Bardeen
507 : !! @version May-2009
508 : !!
509 : !! @see CARMAGROUP_Get
510 0 : subroutine CARMAGROUP_Print(carma, igroup, rc)
511 : type(carma_type), intent(in) :: carma !! the carma object
512 : integer, intent(in) :: igroup !! the group index
513 : integer, intent(out) :: rc !! return code, negative indicates failure
514 :
515 : ! Local variables
516 : integer :: i
517 : character(len=CARMA_NAME_LEN) :: name ! name
518 : character(len=CARMA_SHORT_NAME_LEN) :: shortname ! shortname
519 : real(kind=f) :: rmin ! the minimum radius [cm]
520 : real(kind=f) :: rmrat ! the volume ratio between bins
521 : integer :: ishape ! the type of the particle shape
522 : real(kind=f) :: eshape ! the aspect ratio of the particle shape
523 : logical :: is_ice ! is this an ice particle?
524 : logical :: is_fractal ! is this a fractal?
525 : integer :: irhswell ! the parameterization for particle swelling
526 : ! from relative humidity
527 : integer :: irhswcomp ! the composition for particle swelling
528 : ! from relative humidity
529 : integer :: cnsttype ! constituent type in the parent model
530 0 : real(kind=f) :: r(carma%f_NBIN) ! the bin radius [m]
531 0 : real(kind=f) :: dr(carma%f_NBIN) ! the bin width in radius space [m]
532 0 : real(kind=f) :: rmass(carma%f_NBIN) ! the bin mass [kg]
533 0 : real(kind=f) :: dm(carma%f_NBIN) ! the bin width in mass space [kg]
534 0 : real(kind=f) :: vol(carma%f_NBIN) ! the bin volume [m<sup>3</sup>]
535 : integer :: ifallrtn ! fall velocity routine [I_FALLRTN_STD
536 : ! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
537 : ! | I_FALLRTN_ACKERMAN_DROP | I_FALLRTN_ACKERMAN_ICE]
538 : logical :: is_cloud ! is this a cloud particle?
539 : real(kind=f) :: rmassmin ! the minimum mass [g]
540 : logical :: do_mie ! do mie calculations?
541 : logical :: do_wetdep ! do wet deposition for this particle?
542 : logical :: do_drydep ! do dry deposition for this particle?
543 : logical :: do_vtran ! do sedimentation for this particle?
544 : integer :: imiertn ! mie scattering routine
545 : integer :: iopticstype ! optical properties routine
546 : logical :: is_sulfate ! is this a sulfate particle?
547 : real(kind=f) :: dpc_threshold ! convergence criteria for particle concentration
548 : ! [fraction]
549 : real(kind=f) :: neutral_volfrc ! volume fraction of core mass for neutralization
550 :
551 : ! Assume success.
552 0 : rc = RC_OK
553 :
554 : ! Test out the Get method.
555 0 : if (carma%f_do_print) then
556 : call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, &
557 : rmin=rmin, rmrat=rmrat, ishape=ishape, eshape=eshape, &
558 : is_ice=is_ice, is_fractal=is_fractal, is_cloud=is_cloud, &
559 : irhswell=irhswell, irhswcomp=irhswcomp, cnsttype=cnsttype, &
560 : r=r, dr=dr, rmass=rmass, dm=dm, vol=vol, ifallrtn=ifallrtn, &
561 : rmassmin=rmassmin, do_mie=do_mie, do_wetdep=do_wetdep, &
562 : do_drydep=do_drydep, do_vtran=do_vtran, imiertn=imiertn, &
563 : iopticstype=iopticstype, neutral_volfrc=neutral_volfrc, &
564 0 : is_sulfate=is_sulfate, dpc_threshold=dpc_threshold)
565 0 : if (rc < 0) return
566 :
567 :
568 0 : write(carma%f_LUNOPRT,*) " name : ", trim(name)
569 0 : write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
570 0 : write(carma%f_LUNOPRT,*) " rmin : ", rmin, " (cm)"
571 0 : write(carma%f_LUNOPRT,*) " rmassmin : ", rmassmin, " (g)"
572 0 : write(carma%f_LUNOPRT,*) " rmrat : ", rmrat
573 0 : write(carma%f_LUNOPRT,*) " dpc_threshold : ", dpc_threshold
574 :
575 0 : select case(ishape)
576 : case (I_SPHERE)
577 0 : write(carma%f_LUNOPRT,*) " ishape : spherical"
578 : case (I_HEXAGON)
579 0 : write(carma%f_LUNOPRT,*) " ishape : hexagonal"
580 : case (I_CYLINDER)
581 0 : write(carma%f_LUNOPRT,*) " ishape : cylindrical"
582 : case default
583 0 : write(carma%f_LUNOPRT,*) " ishape : unknown, ", ishape
584 : end select
585 :
586 0 : write(carma%f_LUNOPRT,*) " eshape : ", eshape
587 0 : write(carma%f_LUNOPRT,*) " is_ice : ", is_ice
588 0 : write(carma%f_LUNOPRT,*) " is_fractal : ", is_fractal
589 0 : write(carma%f_LUNOPRT,*) " is_cloud : ", is_cloud
590 0 : write(carma%f_LUNOPRT,*) " is_sulfate : ", is_sulfate
591 :
592 0 : write(carma%f_LUNOPRT,*) " do_drydep : ", do_drydep
593 0 : write(carma%f_LUNOPRT,*) " do_mie : ", do_mie
594 0 : write(carma%f_LUNOPRT,*) " do_vtran : ", do_vtran
595 0 : write(carma%f_LUNOPRT,*) " do_wetdep : ", do_wetdep
596 0 : write(carma%f_LUNOPRT,*) " neutral_volfrc: ", neutral_volfrc
597 :
598 0 : select case(irhswell)
599 : case (0)
600 0 : write(carma%f_LUNOPRT,*) " irhswell : none"
601 : case (I_FITZGERALD)
602 0 : write(carma%f_LUNOPRT,*) " irhswell : Fitzgerald"
603 : case (I_GERBER)
604 0 : write(carma%f_LUNOPRT,*) " irhswell : Gerber"
605 : case default
606 0 : write(carma%f_LUNOPRT,*) " irhswell : unknown, ", irhswell
607 : end select
608 :
609 0 : select case(irhswcomp)
610 : case (0)
611 0 : write(carma%f_LUNOPRT,*) " irhswcomp : none"
612 :
613 : case (I_SWF_NH42SO4)
614 0 : write(carma%f_LUNOPRT,*) " irhswcomp : (NH4)2SO4 (Fitzgerald)"
615 : case (I_SWF_NH4NO3)
616 0 : write(carma%f_LUNOPRT,*) " irhswcomp : NH4NO3 (Fitzgerald)"
617 : case (I_SWF_NANO3)
618 0 : write(carma%f_LUNOPRT,*) " irhswcomp : NaNO3 (Fitzgerald)"
619 : case (I_SWF_NH4CL)
620 0 : write(carma%f_LUNOPRT,*) " irhswcomp : NH4Cl (Fitzgerald)"
621 : case (I_SWF_CACL2)
622 0 : write(carma%f_LUNOPRT,*) " irhswcomp : CaCl2 (Fitzgerald)"
623 : case (I_SWF_NABR)
624 0 : write(carma%f_LUNOPRT,*) " irhswcomp : NaBr (Fitzgerald)"
625 : case (I_SWF_NACL)
626 0 : write(carma%f_LUNOPRT,*) " irhswcomp : NaCl (Fitzgerald)"
627 : case (I_SWF_MGCL2)
628 0 : write(carma%f_LUNOPRT,*) " irhswcomp : MgCl2 (Fitzgerald)"
629 : case (I_SWF_LICL)
630 0 : write(carma%f_LUNOPRT,*) " irhswcomp : LiCl (Fitzgerald)"
631 :
632 : case (I_SWG_NH42SO4)
633 0 : write(carma%f_LUNOPRT,*) " irhswcomp : (NH4)2SO4 (Gerber)"
634 : case (I_SWG_RURAL)
635 0 : write(carma%f_LUNOPRT,*) " irhswcomp : Rural (Gerber)"
636 : case (I_SWG_SEA_SALT)
637 0 : write(carma%f_LUNOPRT,*) " irhswcomp : Sea Salt (Gerber)"
638 : case (I_SWG_URBAN)
639 0 : write(carma%f_LUNOPRT,*) " irhswcomp : Urban (Gerber)"
640 :
641 : case default
642 0 : write(carma%f_LUNOPRT,*) " irhswell : unknown, ", irhswcomp
643 : end select
644 :
645 0 : select case(cnsttype)
646 : case (0)
647 0 : write(carma%f_LUNOPRT,*) " cnsttype : none"
648 : case (I_CNSTTYPE_PROGNOSTIC)
649 0 : write(carma%f_LUNOPRT,*) " cnsttype : prognostic"
650 : case (I_CNSTTYPE_DIAGNOSTIC)
651 0 : write(carma%f_LUNOPRT,*) " cnsttype : diagnostic"
652 : case default
653 0 : write(carma%f_LUNOPRT,*) " cnsttype : unknown, ", cnsttype
654 : end select
655 :
656 0 : select case(ifallrtn)
657 : case (I_FALLRTN_STD)
658 0 : write(carma%f_LUNOPRT,*) " ifallrtn : standard"
659 : case (I_FALLRTN_STD_SHAPE)
660 0 : write(carma%f_LUNOPRT,*) " ifallrtn : standard (shape)"
661 : case (I_FALLRTN_HEYMSFIELD2010)
662 0 : write(carma%f_LUNOPRT,*) " ifallrtn : Heymsfield & Westbrook, 2010"
663 : case default
664 0 : write(carma%f_LUNOPRT,*) " ifallrtn : unknown, ", ifallrtn
665 : end select
666 :
667 0 : select case(imiertn)
668 : case (I_MIERTN_TOON1981)
669 0 : write(carma%f_LUNOPRT,*) " imiertn : Toon & Ackerman, 1981"
670 : case (I_MIERTN_BOHREN1983)
671 0 : write(carma%f_LUNOPRT,*) " imiertn : Bohren & Huffman, 1983"
672 : case (I_MIERTN_BOTET1997)
673 0 : write(carma%f_LUNOPRT,*) " imiertn : Botet, Rannou & Cabane, 1997"
674 : case default
675 0 : write(carma%f_LUNOPRT,*) " imiertn : unknown, ", imiertn
676 : end select
677 :
678 0 : select case(iopticstype)
679 : case (I_OPTICS_FIXED)
680 0 : write(carma%f_LUNOPRT,*) " iopticstype : Fixed Composition"
681 : case (I_OPTICS_MIXED_YU2015)
682 0 : write(carma%f_LUNOPRT,*) " iopticstype : Yu (2015), mixed group"
683 : case (I_OPTICS_SULFATE_YU2015)
684 0 : write(carma%f_LUNOPRT,*) " iopticstype : Yu (2015), pure sulfate group"
685 : case (I_OPTICS_MIXED_CORESHELL)
686 0 : write(carma%f_LUNOPRT,*) " iopticstype : Mixed group, core/shell optics"
687 : case (I_OPTICS_MIXED_VOLUME)
688 0 : write(carma%f_LUNOPRT,*) " iopticstype : Mixed group, Mie optics, volume mixing"
689 : case (I_OPTICS_MIXED_MAXWELL)
690 0 : write(carma%f_LUNOPRT,*) " iopticstype : Mixed group, Mie optics, Maxwell-Garnett mixing"
691 : case (I_OPTICS_SULFATE)
692 0 : write(carma%f_LUNOPRT,*) " iopticstype : Sulfate Group, Refractive index varies with WTP/RH"
693 : case default
694 0 : write(carma%f_LUNOPRT,*) " iopticstype : unknown, ", iopticstype
695 : end select
696 :
697 0 : write(carma%f_LUNOPRT,*)
698 0 : write(carma%f_LUNOPRT,"(' ', a4, 5a12)") "bin", "r", "dr", "rmass", "dm", "vol"
699 0 : write(carma%f_LUNOPRT,"(' ', a4, 5a12)") "", "(cm)", "(cm)", "(g)", "(g)", "(cm3)"
700 :
701 0 : do i = 1, carma%f_NBIN
702 0 : write(carma%f_LUNOPRT, "(' ', i4, 5g12.3)") i, r(i), dr(i), rmass(i), dm(i), vol(i)
703 : end do
704 : end if
705 :
706 : return
707 : end subroutine CARMAGROUP_Print
708 :
709 : !! Sets information about a group.
710 : !!
711 : !! Group optical properties may not be set by the CARMA initialization and
712 : !! may instead be specified by an outside source (e.g. read in from a file).
713 : !!
714 : !! @author Chuck Bardeen
715 : !! @version May-2013
716 : !!
717 : !! @see CARMAGROUP_Create
718 : !! @see CARMA_GetGroup
719 : !! @see CARMA_Initialize
720 : subroutine CARMAGROUP_Set(carma, igroup, rc, qext, ssa, asym)
721 :
722 : type(carma_type), intent(inout) :: carma !! the carma object
723 : integer, intent(in) :: igroup !! the group index
724 : integer, intent(out) :: rc !! return code, negative indicates failure
725 : real(kind=f), intent(in), optional :: qext(carma%f_NWAVE,carma%f_NBIN) !! extinction efficiency
726 : real(kind=f), intent(in), optional :: ssa(carma%f_NWAVE,carma%f_NBIN) !! single scattering albedo
727 : real(kind=f), intent(in), optional :: asym(carma%f_NWAVE,carma%f_NBIN) !! asymmetry factor
728 :
729 : ! Assume success.
730 : rc = RC_OK
731 :
732 : ! Make sure there are enough groups allocated.
733 : if (igroup > carma%f_NGROUP) then
734 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Set:: ERROR - The specifed group (", &
735 : igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
736 : rc = RC_ERROR
737 : return
738 : end if
739 :
740 : ! Set any requested properties of the group.
741 : if (carma%f_NWAVE == 0) then
742 : if (present(qext) .or. present(ssa) .or. present(asym)) then
743 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get: ERROR no optical properties defined."
744 : rc = RC_ERROR
745 : return
746 : end if
747 : else
748 : if (present(qext)) carma%f_group(igroup)%f_qext(:,:) = qext(:,:)
749 : if (present(ssa)) carma%f_group(igroup)%f_ssa(:,:) = ssa(:,:)
750 : if (present(asym)) carma%f_group(igroup)%f_asym(:,:) = asym(:,:)
751 : end if
752 :
753 : return
754 : end subroutine CARMAGROUP_Set
755 :
756 : end module carmagroup_mod
|
