Line data Source code
1 : !! The CARMA module contains an interface to the Community Aerosol and Radiation
2 : !! Model for Atmospheres (CARMA) bin microphysical model [Turco et al. 1979;
3 : !! Toon et al. 1988]. This implementation has been customized to work within
4 : !! other model frameworks, so although it can be provided with an array of
5 : !! columns, it does not do horizontal transport and just does independent 1-D
6 : !! calculations upon each column.
7 : !!
8 : !! The typical usage for the CARMA and CARMASTATE objects within a model would be:
9 : !!>
10 : !! ! This first section of code is done during the parent model's initialzation,
11 : !! ! and there should be a unique CARMA object created for each thread of
12 : !! ! execution.
13 : !!
14 : !! ! Create the CARMA object.
15 : !! call CARMA_Create(carma, ...)
16 : !!
17 : !! ! Define the microphysical components.
18 : !! call CARMAGROUP_Create(carma, ...) ! One or more calls
19 : !!
20 : !! call CARMAELEMENT_Create(carma, ...) ! One or more calls
21 : !!
22 : !! call CARMASOLUTE_Create(carma, ...) ! Zero or more calls
23 : !!
24 : !! call CARMAGAS_Create(carma, ...) ! Zero or more calls
25 : !!
26 : !! ! Define the relationships for the microphysical processes.
27 : !! call CARMA_AddCoagulation(carma, ...) ! Zero or more calls
28 : !! call CARMA_AddGrowth(carma, ...) ! Zero or more calls
29 : !! call CARMA_AddNucleation(carma, ...) ! Zero or more calls
30 : !!
31 : !! ! Initialize things that are state and timestep independent.
32 : !! call CARMA_Initialize(carma, ...)
33 : !!
34 : !! ...
35 : !!
36 : !! ! This section of code is within the parent model's timing loop.
37 : !! !
38 : !! ! NOTE: If using OPEN/MP, then each thread will execute one of
39 : !! ! of these loops per column of data. To avoid having to destroy
40 : !! ! the CARMASTATE object, a pool of CARMASTATE objects could be
41 : !! ! created so that there is one per thread and then the
42 : !! ! CARMA_Destroy() could be called after all columns have been
43 : !! ! processed.
44 : !!
45 : !! ! Initialize CARMA for this model state and timestep.
46 : !! call CARMASTATE_Create(cstate, carma, ...)
47 : !!
48 : !! ! Set the model state for each bin and gas.
49 : !! call CARMASTATE_SetBin(cstate, ...) ! One call for each bin
50 : !! call CARMASTATE_SetGas(cstate, ...) ! One call for each gas
51 : !!
52 : !! ! Calculate the new state
53 : !! call CARMASTATE_Step(cstate, ...)
54 : !!
55 : !! ! Get the results to return back to the parent model.
56 : !! call CARMASTATE_GetBin(cstate, ...) ! One call for each Bin
57 : !! call CARMASTATE_GetGas(cstate, ...) ! One call for each gas
58 : !! call CARMASTATE_GetState(cstate, ...) ! Zero or one calls
59 : !!
60 : !! ! (optional) Deallocate arrays that are not needed beyond this timestep.
61 : !! call CARMASTATE_Destroy(cstate)
62 : !!
63 : !! ...
64 : !!
65 : !! ! This section of code is done during the parent model's cleanup.
66 : !!
67 : !! ! Deallocate all arrays.
68 : !! call CARMA_Destroy(carma)
69 : !!<
70 : !!
71 : !! @version Feb-2009
72 : !! @author Chuck Bardeen, Pete Colarco, Jamie Smith
73 : !
74 : ! NOTE: Documentation for this code can be generated automatically using f90doc,
75 : ! which is freely available from:
76 : ! http://erikdemaine.org/software/f90doc/
77 : ! Comment lines with double comment characters are processed by f90doc, and there are
78 : ! some special characters added to the comments to control the documentation process.
79 : ! In addition to the special characters mentioned in the f990doc documentation, html
80 : ! formatting tags (e.g. <i></i>, <sup></sup>, ...) can also be added to the f90doc
81 : ! comments.
82 : module carma_mod
83 :
84 : ! This module maps the parents models constants into the constants need by CARMA. NOTE: CARMA
85 : ! constants are in CGS units, while the parent models are typically in MKS units.
86 : use carma_precision_mod
87 : use carma_enums_mod
88 : use carma_constants_mod
89 : use carma_types_mod
90 :
91 : ! CARMA explicitly declares all variables.
92 : implicit none
93 :
94 : ! All CARMA variables and procedures are private except those explicitly declared to be public.
95 : private
96 :
97 : ! Declare the public methods.
98 : public CARMA_AddCoagulation
99 : public CARMA_AddGrowth
100 : public CARMA_AddNucleation
101 : public CARMA_Create
102 : public CARMA_Destroy
103 : public CARMA_Get
104 : public CARMA_Initialize
105 :
106 : contains
107 :
108 : ! These are the methods that provide the interface between the parent model and the CARMA
109 : ! microphysical model. There are many other methods that are not in this file that are
110 : ! used to implement the microphysical calculations needed by the CARMA model. These other
111 : ! methods are in effect private methods of the CARMA module, but are in individual files
112 : ! since that is the way that CARMA has traditionally been structured and where users may
113 : ! want to extend or replace code to affect the microphysics.
114 :
115 : !! Creates the CARMA object and allocates arrays to store configuration information
116 : !! that will follow from the CARMA_AddXXX() methods. When the CARMA object is no longer
117 : !! needed, the CARMA_Destroy() method should be used to clean up any allocations
118 : !! that have happened. If LUNOPRT is specified, then the logical unit should be open and
119 : !! ready for output. The caller is responsible for closing the LUNOPRT logical unit
120 : !! after the CARMA object has been destroyed.
121 : !!
122 : !! @version Feb-2009
123 : !! @author Chuck Bardeen
124 1536 : subroutine CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, &
125 4608 : LUNOPRT, wave, dwave, do_wave_emit, NREFIDX)
126 :
127 : type(carma_type), intent(out) :: carma !! the carma object
128 : integer, intent(in) :: NBIN !! number of radius bins per group
129 : integer, intent(in) :: NELEM !! total number of elements
130 : integer, intent(in) :: NGROUP !! total number of groups
131 : integer, intent(in) :: NSOLUTE !! total number of solutes
132 : integer, intent(in) :: NGAS !! total number of gases
133 : integer, intent(in) :: NWAVE !! number of wavelengths
134 : integer, intent(out) :: rc !! return code, negative indicates failure
135 : integer, intent(in), optional :: LUNOPRT !! logical unit number for output
136 : real(kind=f), intent(in), optional :: wave(NWAVE) !! wavelength centers (cm)
137 : real(kind=f), intent(in), optional :: dwave(NWAVE) !! wavelength width (cm)
138 : logical, intent(in), optional :: do_wave_emit(NWAVE) !! do emission in band?
139 : integer, intent(in), optional :: NREFIDX !! number of refractive indices per wavelength
140 :
141 : ! Local Varaibles
142 : integer :: ier
143 :
144 : ! Assume success.
145 1536 : rc = RC_OK
146 :
147 : ! Save off the logic unit used for output if one was provided. If one was provided,
148 : ! then assume that CARMA can print output.
149 1536 : if (present(LUNOPRT)) then
150 1536 : carma%f_LUNOPRT = LUNOPRT
151 1536 : carma%f_do_print = .TRUE.
152 : end if
153 :
154 : ! Save the defintion of the number of comonents involved in the microphysics.
155 1536 : carma%f_NGROUP = NGROUP
156 1536 : carma%f_NELEM = NELEM
157 1536 : carma%f_NBIN = NBIN
158 1536 : carma%f_NGAS = NGAS
159 1536 : carma%f_NSOLUTE = NSOLUTE
160 1536 : carma%f_NWAVE = NWAVE
161 1536 : if (present(NREFIDX)) then
162 1536 : carma%f_NREFIDX = NREFIDX
163 : else
164 0 : carma%f_NREFIDX = 0
165 : end if
166 :
167 :
168 : ! Allocate tables for the groups.
169 : allocate( &
170 : carma%f_group(NGROUP), &
171 : carma%f_icoag(NGROUP, NGROUP), &
172 : carma%f_inucgas(NGROUP), &
173 : carma%f_use_ccd(NGROUP,NGROUP), &
174 18432 : stat=ier)
175 1536 : if(ier /= 0) then
176 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating groups, NGROUP=", &
177 0 : carma%f_NGROUP, ", status=", ier
178 0 : rc = RC_ERROR
179 0 : return
180 : endif
181 :
182 : ! Initialize
183 10752 : carma%f_icoag(:, :) = 0
184 4608 : carma%f_inucgas(:) = 0
185 10752 : carma%f_use_ccd(:,:) = .false.
186 :
187 : ! Allocate tables for the elements.
188 : allocate( &
189 : carma%f_element(NELEM), &
190 : carma%f_igrowgas(NELEM), &
191 : carma%f_inuc2elem(NELEM, NELEM), &
192 : carma%f_inucproc(NELEM, NELEM), &
193 : carma%f_ievp2elem(NELEM), &
194 : carma%f_nnuc2elem(NELEM), &
195 : carma%f_nnucelem(NELEM), &
196 : carma%f_inucelem(NELEM,NELEM*NGROUP), &
197 : carma%f_if_nuc(NELEM,NELEM), &
198 : carma%f_rlh_nuc(NELEM, NELEM), &
199 : carma%f_icoagelem(NELEM, NGROUP), &
200 : carma%f_icoagelem_cm(NELEM, NGROUP), &
201 50688 : stat=ier)
202 1536 : if(ier /= 0) then
203 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating elements, NELEM=", &
204 0 : carma%f_NELEM, ", status=", ier
205 0 : rc = RC_ERROR
206 0 : return
207 : endif
208 :
209 : ! Initialize
210 12288 : carma%f_igrowgas(:) = 0
211 87552 : carma%f_inuc2elem(:,:) = 0
212 87552 : carma%f_inucproc(:,:) = 0
213 12288 : carma%f_ievp2elem(:) = 0
214 12288 : carma%f_nnuc2elem(:) = 0
215 12288 : carma%f_nnucelem(:) = 0
216 173568 : carma%f_inucelem(:,:) = 0
217 87552 : carma%f_if_nuc(:,:) = .FALSE.
218 87552 : carma%f_rlh_nuc(:,:) = 0._f
219 26112 : carma%f_icoagelem(:,:) = 0
220 26112 : carma%f_icoagelem_cm(:,:) = 0
221 :
222 :
223 : ! Allocate tables for the bins.
224 : allocate( &
225 : carma%f_inuc2bin(NBIN,NGROUP,NGROUP), &
226 : carma%f_ievp2bin(NBIN,NGROUP,NGROUP), &
227 : carma%f_nnucbin(NGROUP,NBIN,NGROUP), &
228 : carma%f_inucbin(NBIN*NGROUP,NGROUP,NBIN,NGROUP), &
229 : carma%f_diffmass(NBIN, NGROUP, NBIN, NGROUP), &
230 : carma%f_volx(NGROUP,NGROUP,NGROUP,NBIN,NBIN), &
231 : carma%f_ilow(NGROUP,NBIN,NBIN*NBIN), &
232 : carma%f_jlow(NGROUP,NBIN,NBIN*NBIN), &
233 : carma%f_iup(NGROUP,NBIN,NBIN*NBIN), &
234 : carma%f_jup(NGROUP,NBIN,NBIN*NBIN), &
235 : carma%f_npairl(NGROUP,NBIN), &
236 : carma%f_npairu(NGROUP,NBIN), &
237 : carma%f_iglow(NGROUP,NBIN,NBIN*NBIN), &
238 : carma%f_jglow(NGROUP,NBIN,NBIN*NBIN), &
239 : carma%f_igup(NGROUP,NBIN,NBIN*NBIN), &
240 : carma%f_jgup(NGROUP,NBIN,NBIN*NBIN), &
241 : carma%f_kbin(NGROUP,NGROUP,NGROUP,NBIN,NBIN), &
242 : carma%f_pkernel(NBIN,NBIN,NGROUP,NGROUP,NGROUP,6), &
243 : carma%f_pratt(3,NBIN,NGROUP), &
244 : carma%f_prat(4,NBIN,NGROUP), &
245 : carma%f_pden1(NBIN,NGROUP), &
246 : carma%f_palr(4,NGROUP), &
247 124416 : stat=ier)
248 1536 : if(ier /= 0) then
249 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating bins, NBIN=", &
250 0 : carma%f_NBIN, ", status=", ier
251 0 : rc = RC_ERROR
252 0 : return
253 : endif
254 :
255 : ! Initialize
256 133632 : carma%f_inuc2bin(:,:,:) = 0
257 133632 : carma%f_ievp2bin(:,:,:) = 0
258 188928 : carma%f_nnucbin(:,:,:) = 0
259 5104128 : carma%f_inucbin(:,:,:,:) = 0
260 2646528 : carma%f_diffmass(:, :, :, :) = 0._f
261 9248256 : carma%f_volx(:,:,:,:,:) = 0._f
262 37479936 : carma%f_ilow(:,:,:) = 0
263 37479936 : carma%f_jlow(:,:,:) = 0
264 37479936 : carma%f_iup(:,:,:) = 0
265 37479936 : carma%f_jup(:,:,:) = 0
266 93696 : carma%f_npairl(:,:) = 0
267 93696 : carma%f_npairu(:,:) = 0
268 37479936 : carma%f_iglow(:,:,:) = 0
269 37479936 : carma%f_jglow(:,:,:) = 0
270 37479936 : carma%f_igup(:,:,:) = 0
271 37479936 : carma%f_jgup(:,:,:) = 0
272 9248256 : carma%f_kbin(:,:,:,:,:) = 0._f
273 31105536 : carma%f_pkernel(:,:,:,:,:,:) = 0._f
274 250368 : carma%f_pratt(:,:,:) = 0._f
275 311808 : carma%f_prat(:,:,:) = 0._f
276 66048 : carma%f_pden1(:,:) = 0._f
277 16896 : carma%f_palr(:,:) = 0._f
278 :
279 :
280 : ! Allocate tables for solutes, if any are needed.
281 1536 : if (NSOLUTE > 0) then
282 : allocate( &
283 : carma%f_solute(NSOLUTE), &
284 0 : stat=ier)
285 0 : if(ier /= 0) then
286 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating solutes, NSOLUTE=", &
287 0 : carma%f_NSOLUTE, ", status=", ier
288 0 : rc = RC_ERROR
289 0 : return
290 : endif
291 : end if
292 :
293 :
294 : ! Allocate tables for gases, if any are needed.
295 1536 : if (NGAS > 0) then
296 : allocate( &
297 : carma%f_gas(NGAS), &
298 7680 : stat=ier)
299 1536 : if(ier /= 0) then
300 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating gases, NGAS=", &
301 0 : carma%f_NGAS, ", status=", ier
302 0 : rc = RC_ERROR
303 0 : return
304 : endif
305 : end if
306 :
307 :
308 : ! Allocate tables for optical properties, if any are needed.
309 1536 : if (NWAVE > 0) then
310 : allocate( &
311 : carma%f_wave(NWAVE), &
312 : carma%f_dwave(NWAVE), &
313 : carma%f_do_wave_emit(NWAVE), &
314 10752 : stat=ier)
315 1536 : if(ier /= 0) then
316 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating wavelengths, NWAVE=", &
317 0 : carma%f_NWAVE, ", status=", ier
318 0 : rc = RC_ERROR
319 0 : return
320 : endif
321 :
322 : ! Initialize
323 47616 : carma%f_do_wave_emit(:) = .TRUE.
324 :
325 47616 : if (present(wave)) carma%f_wave(:) = wave(:)
326 47616 : if (present(dwave)) carma%f_dwave(:) = dwave(:)
327 47616 : if (present(do_wave_emit)) carma%f_do_wave_emit(:) = do_wave_emit(:)
328 : end if
329 :
330 : return
331 4608 : end subroutine CARMA_Create
332 :
333 : !! Called after the CARMA object has been created and the microphysics description has been
334 : !! configured. The optional flags control which microphysical processes are enabled and all of
335 : !! them default to FALSE. For a microphysical process to be active it must have been both
336 : !! configured (using a CARMA_AddXXX() method) and enabled here.
337 : !!
338 : !! NOTE: After initialization, the structure of the particle size bins is determined, and
339 : !! the resulting r, dr, rmass and dm can be retrieved with the CARMA_GetGroup() method.
340 : !!
341 : !! @version Feb-2009
342 : !! @author Chuck Bardeen
343 1536 : subroutine CARMA_Initialize(carma, rc, do_cnst_rlh, do_coag, do_detrain, do_fixedinit, &
344 : do_grow, do_incloud, do_explised, do_print_init, do_substep, do_thermo, do_vdiff, &
345 : do_vtran, do_drydep, vf_const, minsubsteps, maxsubsteps, maxretries, conmax, &
346 : do_pheat, do_pheatatm, dt_threshold, cstick, gsticki, gstickl, tstick, do_clearsky, &
347 : do_partialinit, do_coremasscheck, sulfnucl_method )
348 : type(carma_type), intent(inout) :: carma !! the carma object
349 : integer, intent(out) :: rc !! return code, negative indicates failure
350 : logical, intent(in), optional :: do_cnst_rlh !! use constant values for latent heats
351 : !! (instead of varying with temperature)?
352 : logical, intent(in), optional :: do_coag !! do coagulation?
353 : logical, intent(in), optional :: do_detrain !! do detrainement?
354 : logical, intent(in), optional :: do_fixedinit !! do initialization from reference atm?
355 : logical, intent(in), optional :: do_grow !! do nucleation, growth and evaporation?
356 : logical, intent(in), optional :: do_incloud !! do incloud growth and coagulation?
357 : logical, intent(in), optional :: do_explised !! do sedimentation with substepping
358 : logical, intent(in), optional :: do_substep !! do substepping
359 : logical, intent(in), optional :: do_print_init !! do prinit initializtion information
360 : logical, intent(in), optional :: do_thermo !! do thermodynamics
361 : logical, intent(in), optional :: do_vdiff !! do Brownian diffusion
362 : logical, intent(in), optional :: do_vtran !! do sedimentation
363 : logical, intent(in), optional :: do_drydep !! do dry deposition
364 : real(kind=f), intent(in), optional :: vf_const !! if specified and non-zero,
365 : !! constant fall velocity for all particles [cm/s]
366 : integer, intent(in), optional :: minsubsteps !! minimum number of substeps, default = 1
367 : integer, intent(in), optional :: maxsubsteps !! maximum number of substeps, default = 1
368 : integer, intent(in), optional :: maxretries !! maximum number of substep retries, default = 5
369 : real(kind=f), intent(in), optional :: conmax !! minimum relative concentration to consider, default = 1e-1
370 : logical, intent(in), optional :: do_pheat !! do particle heating
371 : logical, intent(in), optional :: do_pheatatm !! do particle heating of atmosphere
372 : real(kind=f), intent(in), optional :: dt_threshold !! convergence criteria for temperature [fraction]
373 : real(kind=f), intent(in), optional :: cstick !! accommodation coefficient - coagulation, default = 1.0
374 : real(kind=f), intent(in), optional :: gsticki !! accommodation coefficient - growth (ice), default = 0.93
375 : real(kind=f), intent(in), optional :: gstickl !! accommodation coefficient - growth (liquid), default = 1.0
376 : real(kind=f), intent(in), optional :: tstick !! accommodation coefficient - temperature, default = 1.0
377 : logical, intent(in), optional :: do_clearsky !! do clear sky growth and coagulation?
378 : logical, intent(in), optional :: do_partialinit !! do initialization of coagulation from reference atm (requires do_fixedinit)?
379 : logical, intent(in), optional :: do_coremasscheck
380 : character(len=*), intent(in), optional :: sulfnucl_method
381 :
382 : ! Assume success.
383 1536 : rc = RC_OK
384 :
385 : ! Set default values for control flags.
386 1536 : carma%f_do_cnst_rlh = .FALSE.
387 1536 : carma%f_do_coag = .FALSE.
388 1536 : carma%f_do_detrain = .FALSE.
389 1536 : carma%f_do_fixedinit = .FALSE.
390 1536 : carma%f_do_grow = .FALSE.
391 1536 : carma%f_do_incloud = .FALSE.
392 1536 : carma%f_do_explised = .FALSE.
393 1536 : carma%f_do_pheat = .FALSE.
394 1536 : carma%f_do_pheatatm = .FALSE.
395 1536 : carma%f_do_print_init = .FALSE.
396 1536 : carma%f_do_substep = .FALSE.
397 1536 : carma%f_do_thermo = .FALSE.
398 1536 : carma%f_do_vdiff = .FALSE.
399 1536 : carma%f_do_vtran = .FALSE.
400 1536 : carma%f_do_drydep = .FALSE.
401 1536 : carma%f_dt_threshold = 0._f
402 1536 : carma%f_cstick = 1._f
403 1536 : carma%f_gsticki = 0.93_f
404 1536 : carma%f_gstickl = 1._f
405 1536 : carma%f_tstick = 1._f
406 1536 : carma%f_do_clearsky = .FALSE.
407 1536 : carma%f_do_partialinit = .FALSE.
408 1536 : carma%f_do_coremasscheck = .FALSE.
409 :
410 : ! Store off any control flag values that have been supplied.
411 1536 : if (present(do_cnst_rlh)) carma%f_do_cnst_rlh = do_cnst_rlh
412 1536 : if (present(do_coag)) carma%f_do_coag = do_coag
413 1536 : if (present(do_detrain)) carma%f_do_detrain = do_detrain
414 1536 : if (present(do_fixedinit)) carma%f_do_fixedinit = do_fixedinit
415 1536 : if (present(do_grow)) carma%f_do_grow = do_grow
416 1536 : if (present(do_incloud)) carma%f_do_incloud = do_incloud
417 1536 : if (present(do_explised)) carma%f_do_explised = do_explised
418 1536 : if (present(do_pheat)) carma%f_do_pheat = do_pheat
419 1536 : if (present(do_pheatatm)) carma%f_do_pheatatm = do_pheatatm
420 1536 : if (present(do_print_init)) carma%f_do_print_init = (do_print_init .and. carma%f_do_print)
421 1536 : if (present(do_substep)) carma%f_do_substep = do_substep
422 1536 : if (present(do_thermo)) carma%f_do_thermo = do_thermo
423 1536 : if (present(do_vdiff)) carma%f_do_vdiff = do_vdiff
424 1536 : if (present(do_vtran)) carma%f_do_vtran = do_vtran
425 1536 : if (present(do_drydep)) carma%f_do_drydep = do_drydep
426 1536 : if (present(dt_threshold)) carma%f_dt_threshold = dt_threshold
427 1536 : if (present(cstick)) carma%f_cstick = cstick
428 1536 : if (present(gsticki)) carma%f_gsticki = gsticki
429 1536 : if (present(gstickl)) carma%f_gstickl = gstickl
430 1536 : if (present(tstick)) carma%f_tstick = tstick
431 1536 : if (present(do_clearsky)) carma%f_do_clearsky = do_clearsky
432 1536 : if (present(do_partialinit)) carma%f_do_partialinit = do_partialinit
433 1536 : if (present(do_coremasscheck)) carma%f_do_coremasscheck = do_coremasscheck
434 1536 : if (present(sulfnucl_method)) carma%sulfnucl_method = trim(sulfnucl_method)
435 :
436 : ! Setup the bin structure.
437 1536 : call setupbins(carma, rc)
438 1536 : if (rc < 0) return
439 :
440 : ! Substepping
441 1536 : carma%f_minsubsteps = 1 ! minimum number of substeps
442 1536 : carma%f_maxsubsteps = 1 ! maximum number of substeps
443 1536 : carma%f_maxretries = 1 ! maximum number of retries
444 1536 : carma%f_conmax = 1.e-1_f
445 :
446 1536 : if (present(minsubsteps)) carma%f_minsubsteps = minsubsteps
447 1536 : if (present(maxsubsteps)) carma%f_maxsubsteps = maxsubsteps
448 1536 : if (present(maxretries)) carma%f_maxretries = maxretries
449 1536 : if (present(conmax)) carma%f_conmax = conmax
450 :
451 1536 : carma%f_do_step = .TRUE.
452 :
453 : ! Calculate the Optical Properties
454 : !
455 : ! NOTE: This is only needed by CARMA if particle heating is being used. For
456 : ! fractal particle the optics can be very slow, so only do it if necessary,
457 1536 : if (carma%f_do_pheat) then
458 0 : call CARMA_InitializeOptics(carma, rc)
459 0 : if (rc < 0) return
460 : end if
461 :
462 : ! If any of the processes have initialization that can be done without the state
463 : ! information, then perform that now. This will mostly be checking the configuration
464 : ! and setting up any tables based upon the configuration.
465 1536 : if (carma%f_do_vtran .or. carma%f_do_coag) then
466 1536 : call CARMA_InitializeVertical(carma, rc, vf_const)
467 1536 : if (rc < 0) return
468 : end if
469 :
470 1536 : if (carma%f_do_coag) then
471 1536 : call setupcoag(carma, rc)
472 1536 : if (rc < 0) return
473 : end if
474 :
475 1536 : if (carma%f_do_grow) then
476 1536 : call CARMA_InitializeGrowth(carma, rc)
477 1536 : if (rc < 0) return
478 : end if
479 :
480 1536 : if (carma%f_do_thermo) then
481 0 : call CARMA_InitializeThermo(carma, rc)
482 0 : if (rc < 0) return
483 : end if
484 :
485 : return
486 : end subroutine CARMA_Initialize
487 :
488 :
489 1536 : subroutine CARMA_InitializeGrowth(carma, rc)
490 : type(carma_type), intent(inout) :: carma
491 : integer, intent(out) :: rc
492 :
493 : ! Local Variables
494 : integer :: i
495 : logical :: bad_grid
496 : integer :: igroup ! group index
497 : integer :: igas ! gas index
498 : integer :: isol ! solute index
499 : integer :: ielem ! element index
500 : integer :: ibin ! bin index
501 : integer :: igfrom
502 : integer :: igto
503 : integer :: ibto
504 : integer :: ieto
505 : integer :: ifrom
506 : integer :: iefrom
507 : integer :: jefrom
508 : integer :: ip
509 : integer :: jcore
510 : integer :: iecore
511 : integer :: im
512 : integer :: jnucelem
513 : integer :: inuc2
514 : integer :: neto
515 : integer :: jfrom
516 : integer :: j
517 : integer :: nnucb
518 :
519 : ! Define formats
520 : 1 format(a,': ',12i6)
521 : 2 format(/,a,': ',i6)
522 : 3 format(a,a)
523 : 4 format(a,': ',1pe12.3)
524 : 5 format(/,'Particle nucleation mapping arrays (setupnuc):')
525 : 7 format(/,'Warning: nucleation cannot occur from group',i3, &
526 : ' bin',i3,' into group',i3,' (<inuc2bin> is zero)')
527 :
528 :
529 : ! Assume success.
530 1536 : rc = RC_OK
531 :
532 : ! Compute radius-dependent terms used in PPM advection scheme
533 4608 : do igroup = 1, carma%f_NGROUP
534 58368 : do i = 2,carma%f_NBIN-1
535 0 : carma%f_pratt(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / &
536 55296 : ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
537 55296 : carma%f_pratt(2,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / &
538 110592 : ( carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) )
539 55296 : carma%f_pratt(3,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) ) / &
540 113664 : ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) )
541 : enddo
542 :
543 55296 : do i = 2,carma%f_NBIN-2
544 0 : carma%f_prat(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / &
545 52224 : ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
546 52224 : carma%f_prat(2,i,igroup) = 2._f * carma%f_group(igroup)%f_dm(i+1) * carma%f_group(igroup)%f_dm(i) / &
547 52224 : ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
548 52224 : carma%f_prat(3,i,igroup) = ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / &
549 104448 : ( 2._f*carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
550 52224 : carma%f_prat(4,i,igroup) = ( carma%f_group(igroup)%f_dm(i+2) + carma%f_group(igroup)%f_dm(i+1) ) / &
551 104448 : ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) )
552 52224 : carma%f_pden1(i,igroup) = carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + &
553 107520 : carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i+2)
554 : enddo
555 :
556 4608 : if( carma%f_NBIN .gt. 1 )then
557 0 : carma%f_palr(1,igroup) = &
558 0 : (carma%f_group(igroup)%f_rmassup(1)-carma%f_group(igroup)%f_rmass(1)) / &
559 3072 : (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1))
560 0 : carma%f_palr(2,igroup) = &
561 0 : (carma%f_group(igroup)%f_rmassup(1)/carma%f_group(igroup)%f_rmrat-carma%f_group(igroup)%f_rmass(1)) / &
562 3072 : (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1))
563 0 : carma%f_palr(3,igroup) = &
564 0 : (carma%f_group(igroup)%f_rmassup(carma%f_NBIN-1)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) &
565 3072 : / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1))
566 0 : carma%f_palr(4,igroup) = &
567 0 : (carma%f_group(igroup)%f_rmassup(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) &
568 3072 : / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1))
569 : endif
570 : end do
571 :
572 :
573 : ! Check the nucleation mapping.
574 : !
575 : ! NOTE: This code was moved from setupnuc, because it is not dependent on the model's
576 : ! state. A small part of setupnuc which deals with scrit is state specific, and that was
577 : ! left in setupnuc.
578 :
579 : ! Bin mapping for nucleation : nucleation would transfer mass from particles
580 : ! in <ifrom,igfrom> into target bin <inuc2bin(ifrom,igfrom,igto)> in group
581 : ! <igto>. The target bin is the smallest bin in the target size grid with
582 : ! mass exceeding that of nucleated particle.
583 4608 : do igfrom = 1,carma%f_NGROUP ! nucleation source group
584 10752 : do igto = 1,carma%f_NGROUP ! nucleation target group
585 132096 : do ifrom = 1,carma%f_NBIN ! nucleation source bin
586 :
587 122880 : carma%f_inuc2bin(ifrom,igfrom,igto) = 0
588 :
589 2586624 : do ibto = carma%f_NBIN,1,-1 ! nucleation target bin
590 :
591 2580480 : if( carma%f_group(igto)%f_rmass(ibto) .ge. carma%f_group(igfrom)%f_rmass(ifrom) )then
592 1259520 : carma%f_inuc2bin(ifrom,igfrom,igto) = ibto
593 : endif
594 : enddo
595 : enddo
596 : enddo
597 : enddo
598 :
599 : ! Mappings for nucleation sources:
600 : !
601 : ! <nnucelem(ielem)> is the number of particle elements that nucleate to
602 : ! particle element <ielem>.
603 : !
604 : ! <inuc2elem(jefrom,ielem)> are the particle elements that
605 : ! nucleate to particle element <ielem>, where
606 : ! jefrom = 1,nnucelem(ielem).
607 : !
608 : ! <if_nuc(iefrom,ieto)> is true if nucleation transfers mass from element
609 : ! <iefrom> to element <ieto>.
610 : !
611 : ! <nnucbin(igfrom,ibin,igroup)> is the number of particle bins that nucleate
612 : ! to particles in bin <ibin,igroup> from group <igfrom>.
613 : !
614 : ! <inucbin(jfrom,igfrom,ibin,igto)> are the particle bins
615 : ! that nucleate to particles in bin <ibin,igto>, where
616 : ! jfrom = 1,nnucbin(igfrom,ibin,igto).
617 : !
618 : !
619 : ! First, calculate <nnucelem(ielem)> and <if_nuc(iefrom,ieto)>
620 : ! based on <inucelem(jefrom,ielem)>
621 12288 : do iefrom = 1,carma%f_NELEM
622 87552 : do ieto = 1,carma%f_NELEM
623 86016 : carma%f_if_nuc(iefrom,ieto) = .false.
624 : enddo
625 : enddo
626 :
627 12288 : do ielem = 1,carma%f_NELEM
628 10752 : carma%f_nnuc2elem(ielem) = 0
629 :
630 33792 : do jefrom = 1,carma%f_NGROUP
631 32256 : if( carma%f_inuc2elem(jefrom,ielem) .ne. 0 ) then
632 1536 : carma%f_nnuc2elem(ielem) = carma%f_nnuc2elem(ielem) + 1
633 1536 : carma%f_if_nuc(ielem,carma%f_inuc2elem(jefrom,ielem)) = .true.
634 :
635 :
636 : ! Also check for cases where neither the source or destinaton don't have cores (e.g.
637 : ! melting ice to water drops).
638 3072 : if ((carma%f_group(carma%f_element(ielem)%f_igroup)%f_ncore .eq. 0) .and. &
639 1536 : (carma%f_group(carma%f_element(carma%f_inuc2elem(jefrom,ielem))%f_igroup)%f_ncore .eq. 0)) then
640 :
641 : ! For particle concentration target elements, only count source elements
642 : ! that are also particle concentrations.
643 1536 : carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) = carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) + 1
644 1536 : carma%f_inucelem(carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)),carma%f_inuc2elem(jefrom,ielem)) = ielem
645 : end if
646 : endif
647 : enddo
648 : enddo
649 :
650 : ! Next, enumerate and count elements that nucleate to cores.
651 4608 : do igroup = 1,carma%f_NGROUP
652 :
653 3072 : ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element
654 :
655 12288 : do jcore = 1,carma%f_group(igroup)%f_ncore
656 :
657 7680 : iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core element
658 : ! carma%f_nnucelem(iecore) = 0
659 :
660 64512 : do iefrom = 1,carma%f_NELEM
661 :
662 61440 : if( carma%f_if_nuc(iefrom,iecore) ) then
663 0 : carma%f_nnucelem(iecore) = carma%f_nnucelem(iecore) + 1
664 0 : carma%f_inucelem(carma%f_nnucelem(iecore),iecore) = iefrom
665 : endif
666 : enddo ! iefrom=1,NELEM
667 : enddo ! jcore=1,ncore
668 : enddo ! igroup=1,NGROUP
669 :
670 :
671 : ! Now enumerate and count elements nucleating to particle concentration
672 : ! (itype=I_INVOLATILE and itype=I_VOLATILE) and core second moment
673 : ! (itype=I_COREMASS). Elements with itype = I_VOLATILE are special because all
674 : ! nucleation sources for core elements in same group are also sources
675 : ! for the itype = I_VOLATILE element.
676 4608 : do igroup = 1,carma%f_NGROUP
677 :
678 3072 : ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element
679 3072 : im = carma%f_group(igroup)%f_imomelem ! target core second moment element
680 :
681 : ! carma%f_nnucelem(ip) = 0
682 : ! if( im .ne. 0 )then
683 : ! carma%f_nnucelem(im) = 0
684 : ! endif
685 :
686 12288 : do jcore = 1,carma%f_group(igroup)%f_ncore
687 :
688 7680 : iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core mass element
689 :
690 10752 : do jnucelem = 1,carma%f_nnucelem(iecore) ! elements nucleating to cores
691 :
692 0 : iefrom = carma%f_inucelem(jnucelem,iecore) ! source
693 :
694 : ! For particle concentration target elements, only count source elements
695 : ! that are also particle concentrations.
696 0 : carma%f_nnucelem(ip) = carma%f_nnucelem(ip) + 1
697 0 : carma%f_inucelem(carma%f_nnucelem(ip),ip) = carma%f_group(carma%f_element(iefrom)%f_igroup)%f_ienconc
698 :
699 7680 : if( im .ne. 0 )then
700 0 : carma%f_nnucelem(im) = carma%f_nnucelem(im) + 1
701 0 : carma%f_inucelem(carma%f_nnucelem(im),im) = iefrom
702 : endif
703 : enddo
704 : enddo ! jcore=1,ncore
705 : enddo ! igroup=1,NGROUP
706 :
707 :
708 : ! Now enumerate and count nucleating bins.
709 4608 : do igroup = 1,carma%f_NGROUP ! target group
710 66048 : do ibin = 1,carma%f_NBIN ! target bin
711 187392 : do igfrom = 1,carma%f_NGROUP ! source group
712 :
713 122880 : carma%f_nnucbin(igfrom,ibin,igroup) = 0
714 :
715 2641920 : do ifrom = 1,carma%f_NBIN ! source bin
716 :
717 2580480 : if( carma%f_inuc2bin(ifrom,igfrom,igroup) .eq. ibin ) then
718 110592 : carma%f_nnucbin(igfrom,ibin,igroup) = carma%f_nnucbin(igfrom,ibin,igroup) + 1
719 110592 : carma%f_inucbin(carma%f_nnucbin(igfrom,ibin,igroup),igfrom,ibin,igroup) = ifrom
720 : endif
721 : enddo
722 : enddo ! igfrom=1,NGROUP
723 : enddo ! ibin=1,NBIN=1,NGROUP
724 : enddo ! igroup=1,NGROUP
725 :
726 1536 : if (carma%f_do_print_init) then
727 :
728 : ! Report nucleation mapping arrays (should be 'write' stmts, of course)
729 :
730 2 : write(carma%f_LUNOPRT,*) ' '
731 2 : write(carma%f_LUNOPRT,*) 'Nucleation mapping arrays (setupnuc):'
732 2 : write(carma%f_LUNOPRT,*) ' '
733 2 : write(carma%f_LUNOPRT,*) 'Elements mapping:'
734 :
735 16 : do ielem = 1,carma%f_NELEM
736 14 : write(carma%f_LUNOPRT,*) 'ielem,nnucelem=',ielem,carma%f_nnucelem(ielem)
737 :
738 16 : if(carma%f_nnucelem(ielem) .gt. 0) then
739 4 : do jfrom = 1,carma%f_nnucelem(ielem)
740 4 : write(carma%f_LUNOPRT,*) 'jfrom,inucelem= ',jfrom,carma%f_inucelem(jfrom,ielem)
741 : enddo
742 : endif
743 : enddo
744 :
745 2 : write(carma%f_LUNOPRT,*) ' '
746 2 : write(carma%f_LUNOPRT,*) 'Bin mapping:'
747 :
748 6 : do igfrom = 1,carma%f_NGROUP
749 14 : do igroup = 1,carma%f_NGROUP
750 8 : write(carma%f_LUNOPRT,*) ' '
751 8 : write(carma%f_LUNOPRT,*) 'Groups (from, to) = ', igfrom, igroup
752 :
753 172 : do ibin = 1,carma%f_NBIN
754 160 : nnucb = carma%f_nnucbin(igfrom,ibin,igroup)
755 160 : if(nnucb .eq. 0) write(carma%f_LUNOPRT,*) ' None for bin ',ibin
756 168 : if(nnucb .gt. 0) then
757 114 : write(carma%f_LUNOPRT,*) ' ibin,nnucbin=',ibin,nnucb
758 258 : write(carma%f_LUNOPRT,*) ' inucbin=',(carma%f_inucbin(j,igfrom,ibin,igroup),j=1,nnucb)
759 : endif
760 : enddo
761 : enddo
762 : enddo
763 : endif
764 :
765 :
766 : ! Check that values are valid.
767 12288 : do ielem = 1, carma%f_NELEM
768 :
769 10752 : if( carma%f_element(ielem)%f_isolute .gt. carma%f_NSOLUTE )then
770 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of isolute > NSOLUTE'
771 0 : rc = RC_ERROR
772 0 : return
773 : endif
774 :
775 10752 : if( carma%f_ievp2elem(ielem) .gt. carma%f_NELEM )then
776 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of ievp2elem > NELEM'
777 0 : rc = RC_ERROR
778 0 : return
779 : endif
780 :
781 : ! Check that <isolute> is consistent with <ievp2elem>.
782 12288 : if( carma%f_ievp2elem(ielem) .ne. 0 .and. carma%f_element(ielem)%f_itype .eq. I_COREMASS )then
783 0 : if( carma%f_element(ielem)%f_isolute .ne. carma%f_element(carma%f_ievp2elem(ielem))%f_isolute)then
784 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - isolute and ievp2elem are inconsistent'
785 0 : rc = RC_ERROR
786 0 : return
787 : endif
788 : endif
789 :
790 : ! Check that <isolute> is consistent with <inucgas>.
791 : ! igas = carma%f_inucgas( carma%f_element(ielem)%f_igroup )
792 : ! if( igas .ne. 0 )then
793 : ! if( carma%f_element(ielem)%f_itype .eq. I_COREMASS .and. carma%f_element(ielem)%f_isolute .eq. 0 )then
794 : ! if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - inucgas ne 0 but isolute eq 0'
795 : ! rc = RC_ERROR
796 : ! return
797 : ! endif
798 : ! endif
799 : enddo
800 :
801 12288 : do ielem = 1, carma%f_NELEM
802 12288 : if( carma%f_nnuc2elem(ielem) .gt. 0 ) then
803 3072 : do inuc2 = 1, carma%f_nnuc2elem(ielem)
804 3072 : if( carma%f_inuc2elem(inuc2,ielem) .gt. carma%f_NELEM )then
805 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of inuc2elem > NELEM'
806 0 : rc = RC_ERROR
807 0 : return
808 : endif
809 : enddo
810 : endif
811 : enddo
812 :
813 : ! Particle grids are incompatible if there is no target bin with enough
814 : ! mass to accomodate nucleated particle.
815 : bad_grid = .false.
816 :
817 12288 : do iefrom = 1,carma%f_NELEM ! source element
818 :
819 10752 : igfrom = carma%f_element(iefrom)%f_igroup
820 10752 : neto = carma%f_nnuc2elem(iefrom)
821 :
822 12288 : if( neto .gt. 0 )then
823 :
824 3072 : do inuc2 = 1,neto
825 1536 : ieto = carma%f_inuc2elem(inuc2,iefrom)
826 1536 : igto = carma%f_element(ieto)%f_igroup
827 :
828 33792 : do ifrom = 1,carma%f_NBIN ! source bin
829 32256 : if( carma%f_inuc2bin(ifrom,igfrom,igto) .eq. 0 )then
830 0 : if ((carma%f_do_print) .and. (carma%f_do_print_init)) write(carma%f_LUNOPRT,7) igfrom,ifrom,igto
831 : bad_grid = .true.
832 : endif
833 : enddo
834 : enddo
835 : endif
836 : enddo
837 :
838 1536 : if (carma%f_do_print_init) then
839 :
840 2 : if( bad_grid )then
841 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::Warning - incompatible grids for nucleation'
842 : endif
843 :
844 : ! Report some initialization values!
845 2 : write(carma%f_LUNOPRT,5)
846 6 : write(carma%f_LUNOPRT,1) 'inucgas ',(carma%f_inucgas(i),i=1,carma%f_NGROUP)
847 16 : write(carma%f_LUNOPRT,1) 'inuc2elem',(carma%f_inuc2elem(1,i),i=1,carma%f_NELEM)
848 16 : write(carma%f_LUNOPRT,1) 'ievp2elem',(carma%f_ievp2elem(i),i=1,carma%f_NELEM)
849 16 : write(carma%f_LUNOPRT,1) 'isolute ',(carma%f_element(i)%f_isolute,i=1,carma%f_NELEM)
850 :
851 2 : do isol = 1,carma%f_NSOLUTE
852 0 : write(carma%f_LUNOPRT,2) 'solute number ',isol
853 0 : write(carma%f_LUNOPRT,3) 'solute name: ',carma%f_solute(isol)%f_name
854 0 : write(carma%f_LUNOPRT,4) 'molecular weight',carma%f_solute(isol)%f_wtmol
855 2 : write(carma%f_LUNOPRT,4) 'mass density ',carma%f_solute(isol)%f_rho
856 : enddo
857 : endif
858 :
859 :
860 : ! Initialize indexes for the gases and check to make sure if H2SO4 is used
861 : ! that it occurs after H2O. This is necessary for supersaturation calculations.
862 1536 : carma%f_igash2o = 0
863 1536 : carma%f_igash2so4 = 0
864 1536 : carma%f_igasso2 = 0
865 :
866 4608 : do igas = 1, carma%f_NGAS
867 4608 : if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2O) then
868 1536 : carma%f_igash2o = igas
869 1536 : else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2SO4) then
870 1536 : carma%f_igash2so4 = igas
871 0 : else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_SO2) then
872 0 : carma%f_igasso2 = igas
873 : end if
874 : end do
875 :
876 1536 : if ((carma%f_igash2so4 /= 0) .and. (carma%f_igash2o > carma%f_igash2so4)) then
877 0 : if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - H2O gas must come before H2SO4.'
878 0 : rc = RC_ERROR
879 0 : return
880 : end if
881 :
882 : return
883 : end subroutine CARMA_InitializeGrowth
884 :
885 : !! Calculate the optical properties for each particle bin at each of
886 : !! the specified wavelengths. The optical properties include the
887 : !! extinction efficiency, the single scattering albedo and the
888 : !! asymmetry factor.
889 : !!
890 : !! NOTE: For these calculations, the particles are assumed to be spheres and
891 : !! Mie code is used to calculate the optical properties.
892 : !!
893 : !! @author Chuck Bardeen
894 : !! @version May-2009
895 0 : subroutine CARMA_InitializeOptics(carma, rc)
896 : type(carma_type), intent(inout) :: carma
897 : integer, intent(out) :: rc
898 :
899 : integer :: igroup ! group index
900 : integer :: iwave ! wavelength index
901 : integer :: ibin ! bin index
902 : real(kind=f) :: Qext
903 : real(kind=f) :: Qsca
904 : real(kind=f) :: asym
905 :
906 :
907 : ! Assume success.
908 0 : rc = RC_OK
909 :
910 : ! Were any wavelengths specified?
911 0 : do iwave = 1, carma%f_NWAVE
912 0 : do igroup = 1, carma%f_NGROUP
913 :
914 : ! Should we calculate mie properties for this group?
915 0 : if (carma%f_group(igroup)%f_do_mie) then
916 :
917 0 : do ibin = 1, carma%f_NBIN
918 :
919 : ! Assume the particle is homogeneous (no core).
920 : !
921 : ! Refractive index comes from the concentration element.
922 : !
923 : ! NOTE: The miess does not converge over as broad a
924 : ! range of input parameters as bhmie, but it can handle
925 : ! coated spheres.
926 :
927 : call mie(carma, &
928 0 : carma%f_group(igroup)%f_imiertn, &
929 0 : carma%f_group(igroup)%f_r(ibin), &
930 0 : carma%f_wave(iwave), &
931 0 : carma%f_group(igroup)%f_nmon(ibin), &
932 0 : carma%f_group(igroup)%f_df(ibin), &
933 : carma%f_group(igroup)%f_rmon, &
934 : carma%f_group(igroup)%f_falpha, &
935 0 : carma%f_element(carma%f_group(igroup)%f_ienconc)%f_refidx(iwave, 1), &
936 : 0.0_f, &
937 : 0.0_f, &
938 : Qext, &
939 : Qsca, &
940 : asym, &
941 0 : rc)
942 :
943 0 : if (rc < RC_OK) then
944 0 : if (carma%f_do_print) then
945 : write(carma%f_LUNOPRT, *) "CARMA_InitializeOptics::&
946 0 : &Mie failed for (band, wavelength, group, bin)", &
947 0 : iwave, carma%f_wave(iwave), igroup, ibin
948 : end if
949 0 : return
950 : end if
951 :
952 0 : carma%f_group(igroup)%f_qext(iwave, ibin) = Qext
953 0 : carma%f_group(igroup)%f_ssa(iwave, ibin) = Qsca / Qext
954 0 : carma%f_group(igroup)%f_asym(iwave, ibin) = asym
955 :
956 : end do
957 : end if
958 : end do
959 : end do
960 :
961 : return
962 : end subroutine CARMA_InitializeOptics
963 :
964 : !! Perform initialization of variables related to thermodynamical calculations that
965 : !! are not dependent on the model state.
966 : !!
967 : !! @author Chuck Bardeen
968 : !! @version May-2009
969 0 : subroutine CARMA_InitializeThermo(carma, rc)
970 : type(carma_type), intent(inout) :: carma
971 : integer, intent(out) :: rc
972 :
973 : ! Assume success.
974 0 : rc = RC_OK
975 :
976 0 : return
977 : end subroutine CARMA_InitializeThermo
978 :
979 : !! Perform initialization of variables related to vertical transport that are not dependent
980 : !! on the model state.
981 : !!
982 : !! @author Chuck Bardeen
983 : !! @version May-2009
984 1536 : subroutine CARMA_InitializeVertical(carma, rc, vf_const)
985 : type(carma_type), intent(inout) :: carma
986 : integer, intent(out) :: rc
987 : real(kind=f), intent(in), optional :: vf_const
988 :
989 : ! Assume success.
990 1536 : rc = RC_OK
991 :
992 : ! Was a constant vertical velocity specified?
993 1536 : carma%f_ifall = 1
994 1536 : carma%f_vf_const = 0._f
995 :
996 1536 : if (present(vf_const)) then
997 1536 : if (vf_const /= 0._f) then
998 0 : carma%f_ifall = 0
999 0 : carma%f_vf_const = vf_const
1000 : end if
1001 : end if
1002 :
1003 : ! Specify the boundary conditions for vertical transport.
1004 1536 : carma%f_itbnd_pc = I_FIXED_CONC
1005 1536 : carma%f_ibbnd_pc = I_FIXED_CONC
1006 :
1007 1536 : return
1008 : end subroutine CARMA_InitializeVertical
1009 :
1010 : !! The routine should be called when the carma object is no longer needed. It deallocates
1011 : !! any memory allocations made by CARMA (during CARMA_Create()), and failure to call this
1012 : !!routine could result in memory leaks.
1013 : !!
1014 : !! @author Chuck Bardeen
1015 : !! @version May-2009
1016 : !!
1017 : !! @see CARMA_Create
1018 1536 : subroutine CARMA_Destroy(carma, rc)
1019 : use carmaelement_mod
1020 : use carmagas_mod
1021 : use carmagroup_mod
1022 : use carmasolute_mod
1023 :
1024 : type(carma_type), intent(inout) :: carma
1025 : integer, intent(out) :: rc
1026 :
1027 : ! Local variables
1028 : integer :: ier
1029 : integer :: igroup
1030 : integer :: ielem
1031 : integer :: isolute
1032 : integer :: igas
1033 :
1034 : ! Assume success.
1035 1536 : rc = RC_OK
1036 :
1037 : ! If allocated, deallocate all the variables that were allocated in the Create() method.
1038 1536 : if (allocated(carma%f_group)) then
1039 4608 : do igroup = 1, carma%f_NGROUP
1040 3072 : call CARMAGROUP_Destroy(carma, igroup, rc)
1041 4608 : if (rc < 0) return
1042 : end do
1043 :
1044 : deallocate( &
1045 : carma%f_group, &
1046 : carma%f_icoag, &
1047 : carma%f_inucgas, &
1048 : carma%f_use_ccd, &
1049 4608 : stat=ier)
1050 1536 : if(ier /= 0) then
1051 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating groups, status=", ier
1052 0 : rc = RC_ERROR
1053 : endif
1054 : endif
1055 :
1056 1536 : if (allocated(carma%f_element)) then
1057 12288 : do ielem = 1, carma%f_NELEM
1058 10752 : call CARMAELEMENT_Destroy(carma, ielem, rc)
1059 12288 : if (rc < RC_OK) return
1060 : end do
1061 :
1062 : deallocate( &
1063 : carma%f_element, &
1064 : carma%f_igrowgas, &
1065 : carma%f_inuc2elem, &
1066 : carma%f_inucproc, &
1067 : carma%f_ievp2elem, &
1068 : carma%f_nnuc2elem, &
1069 : carma%f_nnucelem, &
1070 : carma%f_inucelem, &
1071 : carma%f_if_nuc, &
1072 : carma%f_rlh_nuc, &
1073 : carma%f_icoagelem, &
1074 : carma%f_icoagelem_cm, &
1075 12288 : stat=ier)
1076 1536 : if(ier /= 0) then
1077 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating elements, status=", ier
1078 0 : rc = RC_ERROR
1079 : endif
1080 : endif
1081 :
1082 1536 : if (allocated(carma%f_inuc2bin)) then
1083 : deallocate( &
1084 : carma%f_inuc2bin, &
1085 : carma%f_ievp2bin, &
1086 : carma%f_nnucbin, &
1087 : carma%f_inucbin, &
1088 : carma%f_diffmass, &
1089 : carma%f_volx, &
1090 : carma%f_ilow, &
1091 : carma%f_jlow, &
1092 : carma%f_iup, &
1093 : carma%f_jup, &
1094 : carma%f_npairl, &
1095 : carma%f_npairu, &
1096 : carma%f_iglow, &
1097 : carma%f_jglow, &
1098 : carma%f_igup, &
1099 : carma%f_jgup, &
1100 : carma%f_kbin, &
1101 : carma%f_pkernel, &
1102 1536 : stat=ier)
1103 1536 : if(ier /= 0) then
1104 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating bins, status=", ier
1105 0 : rc = RC_ERROR
1106 : endif
1107 : endif
1108 :
1109 1536 : if (carma%f_NSOLUTE > 0) then
1110 0 : do isolute = 1, carma%f_NSOLUTE
1111 0 : call CARMASOLUTE_Destroy(carma, isolute, rc)
1112 0 : if (rc < RC_OK) return
1113 : end do
1114 :
1115 0 : if (allocated(carma%f_solute)) then
1116 : deallocate( &
1117 : carma%f_solute, &
1118 0 : stat=ier)
1119 : if(ier /= 0) then
1120 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating solutes, status=", ier
1121 : rc = RC_ERROR
1122 : endif
1123 : endif
1124 : end if
1125 :
1126 1536 : if (carma%f_NGAS > 0) then
1127 4608 : do igas = 1, carma%f_NGAS
1128 3072 : call CARMAGAS_Destroy(carma, igas, rc)
1129 4608 : if (rc < RC_OK) return
1130 : end do
1131 :
1132 1536 : if (allocated(carma%f_gas)) then
1133 : deallocate( &
1134 : carma%f_gas, &
1135 4608 : stat=ier)
1136 1536 : if(ier /= 0) then
1137 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating gases, status=", ier
1138 0 : rc = RC_ERROR
1139 : endif
1140 : endif
1141 : end if
1142 :
1143 1536 : if (carma%f_NWAVE > 0) then
1144 1536 : if (allocated(carma%f_wave)) then
1145 : deallocate( &
1146 : carma%f_wave, &
1147 : carma%f_dwave, &
1148 : carma%f_do_wave_emit, &
1149 1536 : stat=ier)
1150 1536 : if(ier /= 0) then
1151 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating wavelengths, status=", ier
1152 0 : rc = RC_ERROR
1153 0 : return
1154 : endif
1155 : endif
1156 : endif
1157 :
1158 : return
1159 1536 : end subroutine CARMA_Destroy
1160 :
1161 : ! Configuration
1162 :
1163 : !! Add a coagulation process between two groups (<i>igroup1</i> and <i>igroup2</i>), with the resulting
1164 : !! particle being in the destination group (<i>igroup3</i>). If <i>ck0</i> is specifed, then a constant
1165 : !! coagulation kernel will be used.
1166 4608 : subroutine CARMA_AddCoagulation(carma, igroup1, igroup2, igroup3, icollec, rc, ck0, grav_e_coll0,use_ccd)
1167 : type(carma_type), intent(inout) :: carma !! the carma object
1168 : integer, intent(in) :: igroup1 !! first source group
1169 : integer, intent(in) :: igroup2 !! second source group
1170 : integer, intent(in) :: igroup3 !! destination group
1171 : integer, intent(in) :: icollec !! collection technique [I_COLLEC_CONST | I_COLLEC_FUCHS | I_COLLEC_DATA]
1172 : integer, intent(out) :: rc !! return code, negative indicates failure
1173 : real(kind=f), intent(in), optional :: ck0 !! if specified, forces a constant coagulation kernel
1174 : real(kind=f), intent(in), optional :: grav_e_coll0 !! if <i>icollec</i> is I_COLLEC_CONST
1175 : !! the constant gravitational collection efficiency
1176 : logical, intent(in), optional :: use_ccd !! if ccd is turned on
1177 :
1178 : ! Assume success.
1179 4608 : rc = RC_OK
1180 :
1181 : ! Make sure the groups exists.
1182 4608 : if (igroup1 > carma%f_NGROUP) then
1183 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
1184 0 : igroup1, ") is larger than the number of groups (", carma%f_NGROUP, ")."
1185 0 : rc = RC_ERROR
1186 0 : return
1187 : end if
1188 :
1189 4608 : if (igroup2 > carma%f_NGROUP) then
1190 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
1191 0 : igroup2, ") is larger than the number of groups (", carma%f_NGROUP, ")."
1192 0 : rc = RC_ERROR
1193 0 : return
1194 : end if
1195 :
1196 4608 : if (igroup3 > carma%f_NGROUP) then
1197 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
1198 0 : igroup3, ") is larger than the number of groups (", carma%f_NGROUP, ")."
1199 0 : rc = RC_ERROR
1200 0 : return
1201 : end if
1202 :
1203 : ! Indicate that the groups coagulate together.
1204 4608 : carma%f_icoag(igroup1, igroup2) = igroup3
1205 :
1206 : ! If ck0 was specified, then we use a fixed coagulation rate of ck0.
1207 4608 : if (present(ck0)) then
1208 0 : carma%f_ck0 = ck0
1209 0 : carma%f_icoagop = I_COAGOP_CONST
1210 : else
1211 4608 : carma%f_icoagop = I_COAGOP_CALC
1212 : end if
1213 :
1214 : ! What collection technique is specified.
1215 4608 : if (icollec > I_COLLEC_DATA) then
1216 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed collection method (", &
1217 0 : icollec, ") is unknown."
1218 0 : rc = RC_ERROR
1219 0 : return
1220 : end if
1221 :
1222 4608 : if (icollec == I_COLLEC_CONST) then
1223 0 : if (present(grav_e_coll0)) then
1224 0 : carma%f_grav_e_coll0 = grav_e_coll0
1225 : else
1226 0 : if (carma%f_do_print) then
1227 : write(carma%f_LUNOPRT, *) "CARMA_AddCoagulation::&
1228 : &ERROR - A constant gravitational collection was requests, &
1229 0 : &but grav_e_coll0 was not provided."
1230 : end if
1231 0 : rc = RC_ERROR
1232 0 : return
1233 : end if
1234 : end if
1235 :
1236 4608 : carma%f_icollec = icollec
1237 :
1238 4608 : if(present(use_ccd))then
1239 0 : carma%f_use_ccd(igroup1,igroup2) = use_ccd
1240 : else
1241 4608 : carma%f_use_ccd(igroup1,igroup2) = .false.
1242 : end if
1243 :
1244 : return
1245 1536 : end subroutine CARMA_AddCoagulation
1246 :
1247 : !! Add a growth process between the element (<i>ielem</i>) and gas (<i>igas</i>) specifed. The element
1248 : !! and gas should have already been defined using <i>CARMA_AddElement()</i> and <i>CARMA_AddGas()</i>.
1249 : !!
1250 : !! NOTE: Each element can only have one volatile component.
1251 : !!
1252 : !! @author Chuck Bardeen
1253 : !! @version May-2009
1254 : !!
1255 : !! @see CARMA_AddElement
1256 : !! @see CARMA_AddGas
1257 3072 : subroutine CARMA_AddGrowth(carma, ielem, igas, rc)
1258 : type(carma_type), intent(inout) :: carma !! the carma object
1259 : integer, intent(in) :: ielem !! the element index
1260 : integer, intent(in) :: igas !! the gas index
1261 : integer, intent(out) :: rc !! return code, negative indicates failure
1262 :
1263 : ! Assume success.
1264 3072 : rc = RC_OK
1265 :
1266 : ! Make sure the element exists.
1267 3072 : if (ielem > carma%f_NELEM) then
1268 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", &
1269 0 : ielem, ") is larger than the number of elements (", carma%f_NELEM, ")."
1270 0 : rc = RC_ERROR
1271 0 : return
1272 : end if
1273 :
1274 : ! Make sure there are enough gases allocated.
1275 3072 : if (igas > carma%f_NGAS) then
1276 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed gas (", &
1277 0 : igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
1278 0 : rc = RC_ERROR
1279 0 : return
1280 : end if
1281 :
1282 : ! If not already defined, indicate that the element can grow with the specified gas.
1283 3072 : if (carma%f_igrowgas(ielem) /= 0) then
1284 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", &
1285 0 : ielem, ") already has gas (", carma%f_igrowgas(ielem), ") condensing on it."
1286 0 : rc = RC_ERROR
1287 0 : return
1288 : else
1289 3072 : carma%f_igrowgas(ielem) = igas
1290 : end if
1291 :
1292 3072 : return
1293 : end subroutine CARMA_AddGrowth
1294 :
1295 : !! Add a nucleation process that nucleates one element (<i>elemfrom</i>) to another element (<i>elemto</i>)
1296 : !! using the specified gas (<i>igas</i>). The elements and gas should have already been defined
1297 : !! using <i>CARMA_AddElement()</i> and <i>CARMA_AddGas()</i>. The nucleation scheme is indicated by
1298 : !! inucproc, and can be one of:
1299 : !!
1300 : !! - <i>I_DROPACT</i>
1301 : !! - <i>I_AERFREEZE</i>
1302 : !! - <i>I_DROPFREEZE</i>
1303 : !! - <i>I_ICEMELT</i>
1304 : !! - <i>I_HETNUC</i>
1305 : !! - <i>I_HOMNUC</i>
1306 : !!
1307 : !! There are multiple parameterizations for I_AERFREEZE, so when that is selected the
1308 : !! particular parameterization needs to be indicated by adding it to I_AERFREEZE. The
1309 : !! specific routines are:
1310 : !!
1311 : !! - <i>I_AF_TABAZADEH_2000</i>
1312 : !! - <i>I_AF_KOOP_2000</i>
1313 : !! - <i>I_AF_MOHLER_2010</i>
1314 : !! - <i>I_AF_MURRAY_2010</i>
1315 : !!
1316 : !! One or more of these routines may be selected, but in general one of the first
1317 : !! three should be selected and then it can optionally be combined with the glassy
1318 : !! aerosols (I_AF_MURRAY_2010).
1319 : !!
1320 : !! Total evaporation transfers particle mass from the destination element back to the
1321 : !! element indicated by <i>ievp2elem</i>. This relationship is not automatically generated,
1322 : !! because multiple elements can nucleate to a particular element and therefore the
1323 : !! reverse mapping is not unique.
1324 : !!
1325 : !! NOTE: The gas used for nucleation must be the same for all nucleation defined from
1326 : !! elements of the same group.
1327 : !!
1328 : !! @author Chuck Bardeen
1329 : !! @version Feb-2009
1330 : !! @see I_DROPACT
1331 : !! @see I_AERFREEZE
1332 : !! @see I_DROPFREEZE
1333 : !! @see I_ICEMELT
1334 : !! @see I_HETNUC
1335 : !! @see I_HOMNUC
1336 : !! @see I_AF_TABAZADEH_2000
1337 : !! @see I_AF_KOOP_2000
1338 : !! @see I_AF_MOHLER_2010
1339 : !! @see I_AF_MURRAY_2010
1340 : !! @see CARMA_AddElement
1341 : !! @see CARMA_AddGas
1342 1536 : subroutine CARMA_AddNucleation(carma, ielemfrom, ielemto, inucproc, &
1343 : rlh_nuc, rc, igas, ievp2elem)
1344 :
1345 : use carmaelement_mod, only : CARMAELEMENT_Get
1346 :
1347 : type(carma_type), intent(inout) :: carma !! the carma object
1348 : integer, intent(in) :: ielemfrom !! the source element
1349 : integer, intent(in) :: ielemto !! the destination element
1350 : integer, intent(in) :: inucproc !! the nucleation process
1351 : !! [I_DROPACT | I_AERFREEZE | I_ICEMELT | I_HETNUC | I_HOMNUC]
1352 : real(kind=f), intent(in) :: rlh_nuc !! the latent heat of nucleation [cm<sup>2</sup>/s<sup>2</sup>]
1353 : integer, intent(out) :: rc !! return code, negative indicated failure
1354 : integer, optional, intent(in) :: igas !! the gas
1355 : integer, optional, intent(in) :: ievp2elem !! the element created upon evaporation
1356 :
1357 : integer :: igroup !! group for source element
1358 :
1359 : ! Assume success.
1360 1536 : rc = RC_OK
1361 :
1362 : ! Make sure the elements exist.
1363 1536 : if (ielemfrom > carma%f_NELEM) then
1364 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
1365 0 : ielemfrom, ") is larger than the number of elements (", carma%f_NELEM, ")."
1366 0 : rc = RC_ERROR
1367 0 : return
1368 : end if
1369 :
1370 1536 : if (ielemto > carma%f_NELEM) then
1371 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
1372 0 : ielemto, ") is larger than the number of elements (", carma%f_NELEM, ")."
1373 0 : rc = RC_ERROR
1374 0 : return
1375 : end if
1376 :
1377 1536 : if (present(ievp2elem)) then
1378 0 : if (ievp2elem > carma%f_NELEM) then
1379 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
1380 0 : ievp2elem, ") is larger than the number of elements (", carma%f_NELEM, ")."
1381 0 : rc = RC_ERROR
1382 0 : return
1383 : end if
1384 : end if
1385 :
1386 :
1387 : ! Make sure there are enough gases allocated.
1388 1536 : if (present(igas)) then
1389 1536 : if (igas > carma%f_NGAS) then
1390 0 : if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed gas (", &
1391 0 : igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
1392 0 : rc = RC_ERROR
1393 0 : return
1394 : end if
1395 : end if
1396 :
1397 :
1398 : ! If aerosol freezing is selected, but no I_AF_xxx sub-method is selected, then indicate an error.
1399 1536 : if (inucproc == I_AERFREEZE) then
1400 0 : if (carma%f_do_print) then
1401 : write(carma%f_LUNOPRT, *) "CARMA_AddNucleation::&
1402 0 : &ERROR - I_AERFREEZE was specified without an I_AF_xxx value."
1403 : end if
1404 0 : return
1405 : end if
1406 :
1407 :
1408 : ! Array <inucgas> maps a particle group to its associated gas for nucleation:
1409 : ! Nucleation from group <igroup> is associated with gas <inucgas(igroup)>
1410 : ! Set to zero if particles are not subject to nucleation.
1411 1536 : if (present(igas)) then
1412 1536 : call CARMAELEMENT_Get(carma, ielemfrom, rc, igroup=igroup)
1413 :
1414 1536 : if (rc >= RC_OK) then
1415 1536 : carma%f_inucgas(igroup) = igas
1416 : end if
1417 : end if
1418 :
1419 :
1420 : ! Nucleation transfers particle mass from element <ielem> to element
1421 : ! <inuc2elem(i,ielem)>, where <i> ranges from 0 to the number of elements
1422 : ! nucleating from <ielem>.
1423 : ! carma%f_nnucelem(ielemto) = carma%f_nnucelem(ielemto) + 1
1424 : ! carma%f_inucelem(carma%f_nnucelem(ielemto), ielemto) = ielemfrom
1425 1536 : carma%f_nnuc2elem(ielemfrom) = carma%f_nnuc2elem(ielemfrom) + 1
1426 1536 : carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom) = ielemto
1427 : ! carma%f_if_nuc(ielemfrom,carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom)) = .true.
1428 :
1429 : ! <inucproc(iefrom,ieto)> specifies what nucleation process nucleates
1430 : ! particles from element <ielem> to element <ieto>:
1431 : ! I_DROPACT: Aerosol activation to droplets
1432 : ! I_AERFREEZE: Aerosol homogeneous freezing
1433 : ! I_DROPFREEZE: Droplet homogeneous freezing
1434 : ! I_GLFREEZE: Glassy Aerosol heteroogeneous freezing
1435 : ! I_GLAERFREEZE: Glassy & Aerosol freezing
1436 1536 : carma%f_inucproc(ielemfrom, ielemto) = inucproc
1437 :
1438 :
1439 : ! Total evaporation mapping: total evaporation transfers particle mass from
1440 : ! element <ielem> to element <ievp2elem(ielem)>.
1441 : !
1442 : ! NOTE: This array is not automatically derived from <inuc2elem> because multiple
1443 : ! elements can nucleate to a particular element (reverse mapping is not
1444 : ! unique).
1445 1536 : if (present(ievp2elem)) carma%f_ievp2elem(ielemto) = ievp2elem
1446 :
1447 :
1448 : ! <rlh_nuc(iefrom,ieto)> is the latent heat released by nucleation
1449 : ! from element <iefrom> to element <ieto> [cm^2/s^2].
1450 1536 : carma%f_rlh_nuc(ielemfrom,ielemto) = rlh_nuc
1451 :
1452 1536 : return
1453 1536 : end subroutine
1454 :
1455 :
1456 : ! Query, Control and State I/O
1457 :
1458 : !! Gets the information about the carma object.
1459 : !!
1460 : !! @author Chuck Bardeen
1461 : !! @version May-2009
1462 : !!
1463 : !! @see CARMA_Create
1464 1138182 : subroutine CARMA_Get(carma, rc, LUNOPRT, NBIN, NELEM, NGAS, NGROUP, NSOLUTE, NWAVE, NREFIDX, do_detrain, &
1465 0 : do_drydep, do_fixedinit, do_grow, do_print, do_print_init, do_thermo, wave, dwave, do_wave_emit, &
1466 : do_partialinit,do_coremasscheck,igash2o)
1467 :
1468 : type(carma_type), intent(in) :: carma !! the carma object
1469 : integer, intent(out) :: rc !! return code, negative indicates failure
1470 : integer, optional, intent(out) :: NBIN !! number of radius bins per group
1471 : integer, optional, intent(out) :: NELEM !! total number of elements
1472 : integer, optional, intent(out) :: NGROUP !! total number of groups
1473 : integer, optional, intent(out) :: NSOLUTE !! total number of solutes
1474 : integer, optional, intent(out) :: NGAS !! total number of gases
1475 : integer, optional, intent(out) :: NWAVE !! number of wavelengths
1476 : integer, optional, intent(out) :: NREFIDX !! number of refractive indices per element
1477 : integer, optional, intent(out) :: LUNOPRT !! logical unit number for output
1478 : logical, optional, intent(out) :: do_detrain !! do detrainement?
1479 : logical, optional, intent(out) :: do_drydep !! do dry deposition?
1480 : logical, optional, intent(out) :: do_fixedinit !! do initialization from reference atm?
1481 : logical, optional, intent(out) :: do_grow !! do condensational growth?
1482 : logical, optional, intent(out) :: do_partialinit !! do initialization of coagulation from reference atm?
1483 : logical, optional, intent(out) :: do_print !! do print output?
1484 : logical, optional, intent(out) :: do_print_init !! do print initialization output?
1485 : logical, optional, intent(out) :: do_thermo !! do thermodynamics?
1486 : real(kind=f), optional, intent(out) :: wave(carma%f_NWAVE) !! the wavelengths centers (cm)
1487 : real(kind=f), optional, intent(out) :: dwave(carma%f_NWAVE) !! the wavelengths widths (cm)
1488 : logical, optional, intent(out) :: do_wave_emit(carma%f_NWAVE) !! do emission in this band?
1489 : logical, optional, intent(out) :: do_coremasscheck
1490 : integer, optional, intent(out) :: igash2o !! Gas index for H2O.
1491 :
1492 : ! Assume success.
1493 1138182 : rc = RC_OK
1494 :
1495 1138182 : if (present(LUNOPRT)) LUNOPRT = carma%f_LUNOPRT
1496 1138182 : if (present(NBIN)) NBIN = carma%f_NBIN
1497 1138182 : if (present(NELEM)) NELEM = carma%f_NELEM
1498 1138182 : if (present(NGAS)) NGAS = carma%f_NGAS
1499 1138182 : if (present(NGROUP)) NGROUP = carma%f_NGROUP
1500 1138182 : if (present(NSOLUTE)) NSOLUTE = carma%f_NSOLUTE
1501 1138182 : if (present(NWAVE)) NWAVE = carma%f_NWAVE
1502 1138182 : if (present(NREFIDX)) NREFIDX = carma%f_NREFIDX
1503 :
1504 1138182 : if (present(do_detrain)) do_detrain = carma%f_do_detrain
1505 1138182 : if (present(do_drydep)) do_drydep = carma%f_do_drydep
1506 1138182 : if (present(do_grow)) do_grow = carma%f_do_grow
1507 1138182 : if (present(do_fixedinit)) do_fixedinit = carma%f_do_fixedinit
1508 1138182 : if (present(do_partialinit)) do_partialinit = carma%f_do_partialinit
1509 1138182 : if (present(do_print)) do_print = carma%f_do_print
1510 1138182 : if (present(do_print_init)) do_print_init = carma%f_do_print_init
1511 1138182 : if (present(do_thermo)) do_thermo = carma%f_do_thermo
1512 :
1513 1138182 : if (present(wave)) wave(:) = carma%f_wave(:)
1514 1138182 : if (present(dwave)) dwave(:) = carma%f_dwave(:)
1515 1138182 : if (present(do_wave_emit)) do_wave_emit(:) = carma%f_do_wave_emit(:)
1516 :
1517 1138182 : if (present(do_coremasscheck)) do_coremasscheck = carma%f_do_coremasscheck
1518 :
1519 1138182 : if (present(igash2o)) igash2o = carma%f_igash2o
1520 :
1521 1138182 : return
1522 1139718 : end subroutine CARMA_Get
1523 :
1524 : end module carma_mod
|
