Line data Source code
1 : module rad_constituents
2 :
3 : !------------------------------------------------------------------------------------------------
4 : !
5 : ! Provide constituent distributions and properties to the radiation and
6 : ! cloud microphysics routines.
7 : !
8 : ! The logic to control which constituents are used in the climate calculations
9 : ! and which are used in diagnostic radiation calculations is contained in this module.
10 : !
11 : !------------------------------------------------------------------------------------------------
12 :
13 : use shr_kind_mod, only: r8 => shr_kind_r8
14 : use spmd_utils, only: masterproc
15 : use ppgrid, only: pcols, pver
16 : use physconst, only: rga
17 : use physics_types, only: physics_state
18 : use phys_control, only: use_simple_phys
19 : use constituents, only: cnst_get_ind
20 : use radconstants, only: nradgas, rad_gas_index
21 : use phys_prop, only: physprop_accum_unique_files, physprop_init, &
22 : physprop_get_id, ot_length
23 : use cam_history, only: addfld, fieldname_len, outfld, horiz_only
24 : use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_get_index
25 :
26 :
27 : use cam_abortutils, only: endrun
28 : use cam_logfile, only: iulog
29 :
30 : implicit none
31 : private
32 : save
33 :
34 : ! Public interfaces
35 :
36 : public :: &
37 : rad_cnst_readnl, &! read namelist values and parse
38 : rad_cnst_init, &! find optics files and all constituents
39 : rad_cnst_get_info, &! return info about climate/diagnostic lists
40 : rad_cnst_get_mode_idx, &! return mode index of specified mode type
41 : rad_cnst_get_spec_idx, &! return specie index of specified specie type
42 : rad_cnst_get_gas, &! return pointer to mmr for gasses
43 : rad_cnst_get_aer_mmr, &! return pointer to mmr for aerosols
44 : rad_cnst_get_mam_mmr_idx, &! get constituent index of mam specie mmr (climate list only)
45 : rad_cnst_get_aer_props, &! return physical properties for aerosols
46 : rad_cnst_get_mode_props, &! return physical properties for aerosol modes
47 : rad_cnst_get_mode_num, &! return mode number mixing ratio
48 : rad_cnst_get_mode_num_idx, &! get constituent index of mode number m.r. (climate list only)
49 : rad_cnst_out, &! output constituent diagnostics (mass per layer and column burden)
50 : rad_cnst_get_call_list, &! return list of active climate/diagnostic calls to radiation
51 : rad_cnst_get_bin_props_by_idx, &
52 : rad_cnst_get_bin_mmr_by_idx, &
53 : rad_cnst_get_info_by_bin, &
54 : rad_cnst_get_info_by_bin_spec, &
55 : rad_cnst_get_bin_props, &
56 : rad_cnst_get_bin_num, &
57 : rad_cnst_get_bin_num_idx, &
58 : rad_cnst_get_carma_mmr_idx, &
59 : rad_cnst_get_bin_mmr
60 :
61 : public :: rad_cnst_num_name
62 :
63 : integer, parameter :: cs1 = 256
64 : integer, public, parameter :: N_DIAG = 10
65 : character(len=cs1), public :: iceopticsfile, liqopticsfile
66 : character(len=32), public :: icecldoptics,liqcldoptics
67 : logical, public :: oldcldoptics = .false.
68 :
69 : ! Private module data
70 :
71 : ! max number of strings in mode definitions
72 : integer, parameter :: n_mode_str = 120
73 :
74 : ! max number of strings in bin definitions
75 : integer, parameter :: n_bin_str = 640
76 :
77 : ! max number of externally mixed entities in the climate/diag lists
78 : integer, parameter :: n_rad_cnst = N_RAD_CNST
79 :
80 : ! Namelist variables
81 : character(len=cs1), dimension(n_mode_str) :: mode_defs = ' '
82 : character(len=cs1), dimension(n_bin_str) :: bin_defs = ' '
83 : character(len=cs1) :: rad_climate(n_rad_cnst) = ' '
84 : character(len=cs1) :: rad_diag_1(n_rad_cnst) = ' '
85 : character(len=cs1) :: rad_diag_2(n_rad_cnst) = ' '
86 : character(len=cs1) :: rad_diag_3(n_rad_cnst) = ' '
87 : character(len=cs1) :: rad_diag_4(n_rad_cnst) = ' '
88 : character(len=cs1) :: rad_diag_5(n_rad_cnst) = ' '
89 : character(len=cs1) :: rad_diag_6(n_rad_cnst) = ' '
90 : character(len=cs1) :: rad_diag_7(n_rad_cnst) = ' '
91 : character(len=cs1) :: rad_diag_8(n_rad_cnst) = ' '
92 : character(len=cs1) :: rad_diag_9(n_rad_cnst) = ' '
93 : character(len=cs1) :: rad_diag_10(n_rad_cnst) = ' '
94 :
95 : ! type to provide access to the components of a mode
96 : type :: mode_component_t
97 : integer :: nspec
98 : ! For "source" variables below, value is:
99 : ! 'N' if in pbuf (non-advected)
100 : ! 'A' if in state (advected)
101 : character(len= 1) :: source_num_a ! source of interstitial number conc field
102 : character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species
103 : character(len= 1) :: source_num_c ! source of cloud borne number conc field
104 : character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species
105 : character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial specie mmr fields
106 : character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr of interstitial components
107 : character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields
108 : character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components
109 : character(len= 32), pointer :: type(:) ! specie type (as used in MAM code)
110 : character(len=cs1), pointer :: props(:) ! file containing specie properties
111 : integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species
112 : integer :: idx_num_c ! index in pbuf for number mixing ratio of interstitial species
113 : integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species
114 : integer, pointer :: idx_mmr_c(:) ! index in pbuf for mmr of interstitial species
115 : integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module
116 : end type mode_component_t
117 :
118 : ! type to provide access to all modes
119 : type :: modes_t
120 : integer :: nmodes
121 : character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists
122 : character(len= 32), pointer :: types(:) ! type of mode (as used in MAM code)
123 : type(mode_component_t), pointer :: comps(:) ! components which define the mode
124 : end type modes_t
125 :
126 : type(modes_t), target :: modes ! mode definitions
127 :
128 : ! type to provide access to the components of a bin
129 : type :: bin_component_t
130 : integer :: nspec
131 : ! For "source" variables below, value is:
132 : ! 'N' if in pbuf (non-advected)
133 : ! 'A' if in state (advected)
134 : character(len= 1) :: source_num_a ! source of interstitial number conc field
135 : character(len= 32) :: camname_num_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species
136 : character(len= 1) :: source_num_c ! source of cloud borne number conc field
137 : character(len= 32) :: camname_num_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species
138 :
139 : character(len= 1) :: source_mass_a ! source of interstitial number conc field
140 : character(len= 32) :: camname_mass_a ! name registered in pbuf or constituents for number mixing ratio of interstitial species
141 : character(len= 1) :: source_mass_c ! source of cloud borne number conc field
142 : character(len= 32) :: camname_mass_c ! name registered in pbuf or constituents for number mixing ratio of cloud borne species
143 :
144 : character(len= 1), pointer :: source_mmr_a(:) ! source of interstitial mmr field
145 : character(len= 32), pointer :: camname_mmr_a(:) ! name registered in pbuf or constituents for mmr species
146 : character(len= 1), pointer :: source_mmr_c(:) ! source of cloud borne specie mmr fields
147 : character(len= 32), pointer :: camname_mmr_c(:) ! name registered in pbuf or constituents for mmr of cloud borne components
148 : character(len= 32), pointer :: type(:) ! species type
149 : character(len= 32), pointer :: morph(:) ! species morphology
150 : character(len=cs1), pointer :: props(:) ! file containing specie properties
151 :
152 : integer :: idx_num_a ! index in pbuf or constituents for number mixing ratio of interstitial species
153 : integer :: idx_num_c ! index in pbuf for number mixing ratio of cloud-borne species
154 : integer :: idx_mass_a ! index in pbuf or constituents for mass mixing ratio of interstitial species
155 : integer :: idx_mass_c ! index in pbuf for mass mixing ratio of cloud-borne species
156 :
157 : integer, pointer :: idx_mmr_a(:) ! index in pbuf or constituents for mmr of interstitial species
158 : integer, pointer :: idx_mmr_c(:) ! index in pbuf or constituents for mmr of cloud-borne species
159 : integer, pointer :: idx_props(:) ! ID used to access physical properties of mode species from phys_prop module
160 : end type bin_component_t
161 :
162 : ! type to provide access to all bins
163 : type :: bins_t
164 : integer :: nbins
165 : character(len= 32), pointer :: names(:) ! names used to identify a mode in the climate/diag lists
166 : type(bin_component_t), pointer :: comps(:) ! components which define the mode
167 : end type bins_t
168 :
169 : type(bins_t), target :: bins ! mode definitions
170 :
171 : ! type to provide access to the data parsed from the rad_climate and rad_diag_* strings
172 : type :: rad_cnst_namelist_t
173 : integer :: ncnst
174 : character(len= 1), pointer :: source(:) ! 'A' for state (advected), 'N' for pbuf (non-advected),
175 : ! 'M' for mode, 'Z' for zero
176 : character(len= 64), pointer :: camname(:) ! name registered in pbuf or constituents
177 : character(len=cs1), pointer :: radname(:) ! radname is the name as identfied in radiation,
178 : ! must be one of (rgaslist if a gas) or
179 : ! (/fullpath/filename.nc if an aerosol)
180 : character(len= 1), pointer :: type(:) ! 'A' if aerosol, 'G' if gas, 'M' if mode
181 : end type rad_cnst_namelist_t
182 :
183 : type(rad_cnst_namelist_t) :: namelist(0:N_DIAG) ! gas, bulk aerosol, and modal components used in
184 : ! climate/diagnostic calculations
185 :
186 : logical :: active_calls(0:N_DIAG) ! active_calls(i) is true if the i-th call to radiation is
187 : ! specified. Note that the 0th call is for the climate
188 : ! calculation which is always made.
189 :
190 : ! Storage for gas components in the climate/diagnostic lists
191 :
192 : type :: gas_t
193 : character(len=1) :: source ! A for state (advected), N for pbuf (non-advected), Z for zero
194 : character(len=64) :: camname ! name of constituent in physics state or buffer
195 : character(len=32) :: mass_name ! name for mass per layer field in history output
196 : integer :: idx ! index from constituents or from pbuf
197 : end type gas_t
198 :
199 : type :: gaslist_t
200 : integer :: ngas
201 : character(len=2) :: list_id ! set to " " for climate list, or two character integer
202 : ! (include leading zero) to identify diagnostic list
203 : type(gas_t), pointer :: gas(:) ! dimension(ngas) where ngas = nradgas is from radconstants
204 : end type gaslist_t
205 :
206 : type(gaslist_t), target :: gaslist(0:N_DIAG) ! gasses used in climate/diagnostic calculations
207 :
208 : ! Storage for bulk aerosol components in the climate/diagnostic lists
209 :
210 : type :: aerosol_t
211 : character(len=1) :: source ! A for state (advected), N for pbuf (non-advected), Z for zero
212 : character(len=64) :: camname ! name of constituent in physics state or buffer
213 : character(len=cs1) :: physprop_file ! physprop filename
214 : character(len=32) :: mass_name ! name for mass per layer field in history output
215 : integer :: idx ! index of constituent in physics state or buffer
216 : integer :: physprop_id ! ID used to access physical properties from phys_prop module
217 : end type aerosol_t
218 :
219 : type :: aerlist_t
220 : integer :: numaerosols ! number of aerosols
221 : character(len=2) :: list_id ! set to " " for climate list, or two character integer
222 : ! (include leading zero) to identify diagnostic list
223 : type(aerosol_t), pointer :: aer(:) ! dimension(numaerosols)
224 : end type aerlist_t
225 :
226 : type(aerlist_t), target :: aerosollist(0:N_DIAG) ! list of aerosols used in climate/diagnostic calcs
227 :
228 : ! storage for modal aerosol components in the climate/diagnostic lists
229 :
230 : type :: modelist_t
231 : integer :: nmodes ! number of modes
232 : character(len=2) :: list_id ! set to " " for climate list, or two character integer
233 : ! (include leading zero) to identify diagnostic list
234 : integer, pointer :: idx(:) ! index of the mode in the mode definition object
235 : character(len=cs1), pointer :: physprop_files(:) ! physprop filename
236 : integer, pointer :: idx_props(:) ! index of the mode properties in the physprop object
237 : end type modelist_t
238 :
239 : type(modelist_t), target :: ma_list(0:N_DIAG) ! list of aerosol modes used in climate/diagnostic calcs
240 :
241 : ! storage for modal aerosol components in the climate/diagnostic lists
242 :
243 : type :: binlist_t
244 : integer :: nbins ! number of bins
245 : character(len=2) :: list_id ! set to " " for climate list, or two character integer
246 : ! (include leading zero) to identify diagnostic list
247 : integer, pointer :: idx(:) ! index of the bin in the bin definition object
248 : character(len=cs1), pointer :: physprop_files(:) ! physprop filename
249 : integer, pointer :: idx_props(:) ! index of the bin properties in the physprop object
250 : end type binlist_t
251 :
252 : type(binlist_t), target :: sa_list(0:N_DIAG) ! list of aerosol bins used in climate/diagnostic calcs
253 :
254 : ! values for constituents with requested value of zero
255 : real(r8), allocatable, target :: zero_cols(:,:)
256 :
257 : ! define generic interface routines
258 : interface rad_cnst_get_info
259 : module procedure rad_cnst_get_info
260 : module procedure rad_cnst_get_info_by_mode
261 : module procedure rad_cnst_get_info_by_mode_spec
262 : module procedure rad_cnst_get_info_by_spectype
263 : end interface
264 :
265 : interface rad_cnst_get_aer_mmr
266 : module procedure rad_cnst_get_aer_mmr_by_idx
267 : module procedure rad_cnst_get_mam_mmr_by_idx
268 : end interface
269 :
270 : interface rad_cnst_get_aer_props
271 : module procedure rad_cnst_get_aer_props_by_idx
272 : module procedure rad_cnst_get_mam_props_by_idx
273 : end interface
274 :
275 : logical :: verbose = .true.
276 : character(len=1), parameter :: nl = achar(10)
277 :
278 : integer, parameter :: num_mode_types = 9
279 : integer, parameter :: num_spec_types = 8
280 : character(len=14), parameter :: mode_type_names(num_mode_types) = (/ &
281 : 'accum ', 'aitken ', 'primary_carbon', 'fine_seasalt ', &
282 : 'fine_dust ', 'coarse ', 'coarse_seasalt', 'coarse_dust ', &
283 : 'coarse_strat ' /)
284 : character(len=9), parameter :: spec_type_names(num_spec_types) = (/ &
285 : 'sulfate ', 'ammonium ', 'nitrate ', 'p-organic', &
286 : 's-organic', 'black-c ', 'seasalt ', 'dust '/)
287 :
288 : integer, parameter :: num_bin_morphs = 2
289 : character(len=8), parameter :: bin_morph_names(num_bin_morphs) = &
290 : (/ 'shell ', 'core ' /)
291 :
292 : !==============================================================================
293 : contains
294 : !==============================================================================
295 :
296 1536 : subroutine rad_cnst_readnl(nlfile)
297 :
298 : ! Read rad_cnst_nl namelist group. Parse input.
299 :
300 : use namelist_utils, only: find_group_name
301 : use units, only: getunit, freeunit
302 : use mpishorthand
303 :
304 : character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
305 :
306 : ! Local variables
307 : integer :: unitn, ierr, i
308 : character(len=2) :: suffix
309 1536 : character(len=1), pointer :: ctype(:)
310 : character(len=*), parameter :: subname = 'rad_cnst_readnl'
311 :
312 : namelist /rad_cnst_nl/ mode_defs, &
313 : bin_defs, &
314 : rad_climate, &
315 : rad_diag_1, &
316 : rad_diag_2, &
317 : rad_diag_3, &
318 : rad_diag_4, &
319 : rad_diag_5, &
320 : rad_diag_6, &
321 : rad_diag_7, &
322 : rad_diag_8, &
323 : rad_diag_9, &
324 : rad_diag_10, &
325 : iceopticsfile, &
326 : liqopticsfile, &
327 : icecldoptics, &
328 : liqcldoptics, &
329 : oldcldoptics
330 :
331 : !-----------------------------------------------------------------------------
332 :
333 0 : if (use_simple_phys) return
334 :
335 1536 : if (masterproc) then
336 2 : unitn = getunit()
337 2 : open( unitn, file=trim(nlfile), status='old' )
338 2 : call find_group_name(unitn, 'rad_cnst_nl', status=ierr)
339 2 : if (ierr == 0) then
340 2 : read(unitn, rad_cnst_nl, iostat=ierr)
341 2 : if (ierr /= 0) then
342 0 : call endrun(subname // ':: ERROR reading namelist')
343 : end if
344 : end if
345 2 : close(unitn)
346 2 : call freeunit(unitn)
347 : end if
348 :
349 : #ifdef SPMD
350 : ! Broadcast namelist variables
351 1536 : call mpibcast (mode_defs, len(mode_defs(1))*n_mode_str, mpichar, 0, mpicom)
352 1536 : call mpibcast (bin_defs, len(bin_defs(1))*n_bin_str, mpichar, 0, mpicom)
353 1536 : call mpibcast (rad_climate, len(rad_climate(1))*n_rad_cnst, mpichar, 0, mpicom)
354 1536 : call mpibcast (rad_diag_1, len(rad_diag_1(1))*n_rad_cnst, mpichar, 0, mpicom)
355 1536 : call mpibcast (rad_diag_2, len(rad_diag_2(1))*n_rad_cnst, mpichar, 0, mpicom)
356 1536 : call mpibcast (rad_diag_3, len(rad_diag_3(1))*n_rad_cnst, mpichar, 0, mpicom)
357 1536 : call mpibcast (rad_diag_4, len(rad_diag_4(1))*n_rad_cnst, mpichar, 0, mpicom)
358 1536 : call mpibcast (rad_diag_5, len(rad_diag_5(1))*n_rad_cnst, mpichar, 0, mpicom)
359 1536 : call mpibcast (rad_diag_6, len(rad_diag_6(1))*n_rad_cnst, mpichar, 0, mpicom)
360 1536 : call mpibcast (rad_diag_7, len(rad_diag_7(1))*n_rad_cnst, mpichar, 0, mpicom)
361 1536 : call mpibcast (rad_diag_8, len(rad_diag_8(1))*n_rad_cnst, mpichar, 0, mpicom)
362 1536 : call mpibcast (rad_diag_9, len(rad_diag_9(1))*n_rad_cnst, mpichar, 0, mpicom)
363 1536 : call mpibcast (rad_diag_10, len(rad_diag_10(1))*n_rad_cnst, mpichar, 0, mpicom)
364 1536 : call mpibcast (iceopticsfile, len(iceopticsfile), mpichar, 0, mpicom)
365 1536 : call mpibcast (liqopticsfile, len(liqopticsfile), mpichar, 0, mpicom)
366 1536 : call mpibcast (liqcldoptics, len(liqcldoptics), mpichar, 0, mpicom)
367 1536 : call mpibcast (icecldoptics, len(icecldoptics), mpichar, 0, mpicom)
368 1536 : call mpibcast (oldcldoptics, 1, mpilog , 0, mpicom)
369 : #endif
370 :
371 : ! Parse the namelist input strings
372 :
373 : ! Mode definition stings
374 1536 : call parse_mode_defs(mode_defs, modes)
375 :
376 : ! Bin definition stings
377 1536 : call parse_bin_defs(bin_defs, bins)
378 :
379 : ! Lists of externally mixed entities for climate and diagnostic calculations
380 18432 : do i = 0,N_DIAG
381 1536 : select case (i)
382 : case(0)
383 1536 : call parse_rad_specifier(rad_climate, namelist(i))
384 : case (1)
385 1536 : call parse_rad_specifier(rad_diag_1, namelist(i))
386 : case (2)
387 1536 : call parse_rad_specifier(rad_diag_2, namelist(i))
388 : case (3)
389 1536 : call parse_rad_specifier(rad_diag_3, namelist(i))
390 : case (4)
391 1536 : call parse_rad_specifier(rad_diag_4, namelist(i))
392 : case (5)
393 1536 : call parse_rad_specifier(rad_diag_5, namelist(i))
394 : case (6)
395 1536 : call parse_rad_specifier(rad_diag_6, namelist(i))
396 : case (7)
397 1536 : call parse_rad_specifier(rad_diag_7, namelist(i))
398 : case (8)
399 1536 : call parse_rad_specifier(rad_diag_8, namelist(i))
400 : case (9)
401 1536 : call parse_rad_specifier(rad_diag_9, namelist(i))
402 : case (10)
403 16896 : call parse_rad_specifier(rad_diag_10, namelist(i))
404 : end select
405 : enddo
406 :
407 : ! were there any constituents specified for the nth diagnostic call?
408 : ! if so, radiation will make a call with those consituents
409 18432 : active_calls(:) = (namelist(:)%ncnst > 0)
410 :
411 : ! Initialize the gas and aerosol lists with the information from the
412 : ! namelist. This is done here so that this information is available via
413 : ! the query functions at the time when the register methods are called.
414 :
415 : ! Set the list_id fields which distinquish the climate and diagnostic lists
416 18432 : do i = 0, N_DIAG
417 18432 : if (active_calls(i)) then
418 1536 : if (i > 0) then
419 0 : write(suffix, fmt = '(i2.2)') i
420 : else
421 1536 : suffix=' '
422 : end if
423 1536 : aerosollist(i)%list_id = suffix
424 1536 : gaslist(i)%list_id = suffix
425 1536 : ma_list(i)%list_id = suffix
426 1536 : sa_list(i)%list_id = suffix
427 : end if
428 : end do
429 :
430 : ! Create a list of the unique set of filenames containing property data
431 :
432 : ! Start with the bulk aerosol species in the climate/diagnostic lists.
433 : ! The physprop_accum_unique_files routine has the side effect of returning the number
434 : ! of bulk aerosols in each list (they're identified by type='A').
435 18432 : do i = 0, N_DIAG
436 18432 : if (active_calls(i)) then
437 : call physprop_accum_unique_files(namelist(i)%radname, namelist(i)%type)
438 : endif
439 : enddo
440 :
441 : ! Add physprop files for the species from the mode definitions.
442 1536 : do i = 1, modes%nmodes
443 0 : allocate(ctype(modes%comps(i)%nspec))
444 0 : ctype = 'A'
445 0 : call physprop_accum_unique_files(modes%comps(i)%props, ctype)
446 1536 : deallocate(ctype)
447 : end do
448 :
449 : ! Add physprop files for the species from the bin definitions.
450 62976 : do i = 1, bins%nbins
451 122880 : allocate(ctype(bins%comps(i)%nspec))
452 276480 : ctype = 'A'
453 61440 : call physprop_accum_unique_files(bins%comps(i)%props, ctype)
454 62976 : deallocate(ctype)
455 : end do
456 :
457 : ! Initialize the gas, bulk aerosol, and modal aerosol lists. This step splits the
458 : ! input climate/diagnostic lists into the corresponding gas, bulk and modal aerosol
459 : ! lists.
460 1536 : if (masterproc) write(iulog,*) nl//subname//': Radiation constituent lists:'
461 18432 : do i = 0, N_DIAG
462 18432 : if (active_calls(i)) then
463 : call list_init1(namelist(i), gaslist(i), aerosollist(i), ma_list(i), sa_list(i))
464 :
465 1538 : if (masterproc .and. verbose) then
466 2 : call print_lists(gaslist(i), aerosollist(i), ma_list(i), sa_list(i))
467 : end if
468 :
469 : end if
470 : end do
471 :
472 1536 : if (masterproc .and. verbose) call print_modes(modes)
473 1536 : if (masterproc .and. verbose) call print_bins(bins)
474 :
475 1536 : end subroutine rad_cnst_readnl
476 :
477 : !================================================================================================
478 :
479 1536 : subroutine rad_cnst_init()
480 :
481 : ! The initialization of the gas and aerosol lists is finished by
482 : ! 1) read the physprop files
483 : ! 2) find the index of each constituent in the constituent or physics buffer arrays
484 : ! 3) find the index of the aerosol constituents used to access its properties from the
485 : ! physprop module.
486 :
487 : integer :: i
488 : logical, parameter :: stricttest = .true.
489 : character(len=*), parameter :: subname = 'rad_cnst_init'
490 : !-----------------------------------------------------------------------------
491 :
492 : ! memory to point to if zero value requested
493 1536 : allocate(zero_cols(pcols,pver))
494 1829376 : zero_cols = 0._r8
495 :
496 : ! Allocate storage for the physical properties of each aerosol; read properties from
497 : ! the data files.
498 1536 : call physprop_init()
499 :
500 : ! Start checking that specified radiative constituents are present in the constituent
501 : ! or physics buffer arrays.
502 1536 : if (masterproc) write(iulog,*) nl//subname//': checking for radiative constituents'
503 :
504 : ! Finish initializing the mode definitions.
505 1536 : call init_mode_comps(modes)
506 :
507 : ! Finish initializing the bin definitions.
508 1536 : call init_bin_comps(bins)
509 :
510 : ! Finish initializing the gas, bulk aerosol, and mode lists.
511 18432 : do i = 0, N_DIAG
512 18432 : if (active_calls(i)) then
513 : call list_init2(gaslist(i), aerosollist(i), ma_list(i), sa_list(i))
514 : end if
515 : end do
516 :
517 : ! Check that all gases supported by the radiative transfer code have been specified.
518 : if (stricttest) then
519 13824 : do i = 1, nradgas
520 13824 : if (gaslist(0)%gas(i)%source .eq. 'Z' ) then
521 0 : call endrun(subname//': list of radiative gasses must include all radiation gasses for the climate specication')
522 : endif
523 : enddo
524 : endif
525 :
526 : ! Initialize history output of climate diagnostic quantities
527 1536 : call rad_gas_diag_init(gaslist(0))
528 1536 : call rad_aer_diag_init(aerosollist(0))
529 :
530 :
531 1536 : end subroutine rad_cnst_init
532 :
533 : !================================================================================================
534 :
535 695040 : subroutine rad_cnst_get_gas(list_idx, gasname, state, pbuf, mmr)
536 :
537 : ! Return pointer to mass mixing ratio for the gas from the specified
538 : ! climate or diagnostic list.
539 :
540 : ! Arguments
541 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
542 : character(len=*), intent(in) :: gasname
543 : type(physics_state), target, intent(in) :: state
544 : type(physics_buffer_desc), pointer :: pbuf(:)
545 : real(r8), pointer :: mmr(:,:)
546 :
547 : ! Local variables
548 : integer :: lchnk
549 : integer :: igas
550 : integer :: idx
551 : character(len=1) :: source
552 : type(gaslist_t), pointer :: list
553 : character(len=*), parameter :: subname = 'rad_cnst_get_gas'
554 : !-----------------------------------------------------------------------------
555 :
556 695040 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
557 695040 : list => gaslist(list_idx)
558 : else
559 0 : write(iulog,*) subname//': list_idx =', list_idx
560 0 : call endrun(subname//': list_idx out of bounds')
561 : endif
562 :
563 695040 : lchnk = state%lchnk
564 :
565 : ! Get index of gas in internal arrays. rad_gas_index will abort if the
566 : ! specified gasname is not recognized by the radiative transfer code.
567 695040 : igas = rad_gas_index(trim(gasname))
568 :
569 : ! Get data source
570 695040 : source = list%gas(igas)%source
571 695040 : idx = list%gas(igas)%idx
572 464640 : select case( source )
573 : case ('A')
574 464640 : mmr => state%q(:,:,idx)
575 : case ('N')
576 230400 : call pbuf_get_field(pbuf, idx, mmr)
577 : case ('Z')
578 695040 : mmr => zero_cols
579 : end select
580 :
581 695040 : end subroutine rad_cnst_get_gas
582 :
583 : !================================================================================================
584 :
585 0 : function rad_cnst_num_name(list_idx, spc_name_in, num_name_out, mode_out, spec_out ) result(found)
586 :
587 : ! for a given species name spc_name_in return (optionals):
588 : ! num_name_out -- corresponding number density species name
589 : ! mode_out -- corresponding mode number
590 : ! spec_out -- corresponding species number within the mode
591 :
592 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
593 : character(len=*),intent(in) :: spc_name_in
594 : character(len=*),intent(out):: num_name_out
595 : integer,optional,intent(out):: mode_out
596 : integer,optional,intent(out):: spec_out
597 :
598 : logical :: found
599 :
600 : ! Local variables
601 : type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
602 : integer :: n,m, mm
603 : integer :: nmodes
604 : integer :: nspecs
605 : character(len= 32) :: spec_name
606 :
607 0 : found = .false.
608 :
609 0 : m_list => ma_list(list_idx)
610 0 : nmodes = m_list%nmodes
611 :
612 0 : do n = 1,nmodes
613 0 : mm = m_list%idx(n)
614 0 : nspecs = modes%comps(mm)%nspec
615 0 : do m = 1,nspecs
616 0 : spec_name = modes%comps(mm)%camname_mmr_a(m)
617 0 : if (spc_name_in == spec_name) then
618 0 : num_name_out = modes%comps(mm)%camname_num_a
619 0 : found = .true.
620 0 : if (present(mode_out)) then
621 0 : mode_out = n
622 : endif
623 0 : if (present(spec_out)) then
624 0 : spec_out = m
625 : endif
626 0 : return
627 : endif
628 : enddo
629 : enddo
630 :
631 : return
632 :
633 0 : end function
634 :
635 : !================================================================================================
636 :
637 322560 : subroutine rad_cnst_get_info(list_idx, gasnames, aernames, &
638 : use_data_o3, ngas, naero, nmodes, nbins)
639 :
640 : ! Return info about gas and aerosol lists
641 :
642 : ! Arguments
643 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
644 : character(len=64), optional, intent(out) :: gasnames(:)
645 : character(len=64), optional, intent(out) :: aernames(:)
646 : logical, optional, intent(out) :: use_data_o3
647 : integer, optional, intent(out) :: naero
648 : integer, optional, intent(out) :: ngas
649 : integer, optional, intent(out) :: nmodes
650 : integer, optional, intent(out) :: nbins
651 :
652 : ! Local variables
653 : type(gaslist_t), pointer :: g_list ! local pointer to gas list of interest
654 : type(aerlist_t), pointer :: a_list ! local pointer to aerosol list of interest
655 : type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
656 : type(binlist_t), pointer :: s_list ! local pointer to bin list of interest
657 :
658 : integer :: i
659 : integer :: arrlen ! length of assumed shape array
660 : integer :: gaslen ! length of assumed shape array
661 : integer :: igas ! index of a gas in the gas list
662 : character(len=1) :: source ! A for state, N for pbuf, Z for zero
663 :
664 : character(len=*), parameter :: subname = 'rad_cnst_get_info'
665 : !-----------------------------------------------------------------------------
666 :
667 322560 : g_list => gaslist(list_idx)
668 322560 : a_list => aerosollist(list_idx)
669 322560 : m_list => ma_list(list_idx)
670 322560 : s_list => sa_list(list_idx)
671 :
672 : ! number of bulk aerosols in list
673 322560 : if (present(naero)) then
674 78336 : naero = a_list%numaerosols
675 : endif
676 :
677 : ! number of aerosol modes in list
678 322560 : if (present(nmodes)) then
679 158976 : nmodes = m_list%nmodes
680 : endif
681 :
682 : ! number of aerosol bins in list
683 322560 : if (present(nbins)) then
684 244992 : nbins = s_list%nbins
685 : endif
686 :
687 : ! number of gases in list
688 322560 : if (present(ngas)) then
689 0 : ngas = g_list%ngas
690 : endif
691 :
692 : ! names of aerosols in list
693 322560 : if (present(aernames)) then
694 :
695 : ! check that output array is long enough
696 1536 : arrlen = size(aernames)
697 1536 : if (arrlen < a_list%numaerosols) then
698 0 : write(iulog,*) subname//': ERROR: naero=', a_list%numaerosols, ' arrlen=', arrlen
699 0 : call endrun(subname//': ERROR: aernames too short')
700 : end if
701 :
702 1536 : do i = 1, a_list%numaerosols
703 1536 : aernames(i) = a_list%aer(i)%camname
704 : end do
705 :
706 : end if
707 :
708 : ! names of gas in list
709 322560 : if (present(gasnames)) then
710 :
711 : ! check that output array is long enough
712 0 : gaslen = size(gasnames)
713 0 : if (gaslen < g_list%ngas) then
714 0 : write(iulog,*) subname//': ERROR: ngas=', g_list%ngas, ' gaslen=', gaslen
715 0 : call endrun(subname//': ERROR: gasnames too short')
716 : end if
717 :
718 0 : do i = 1, g_list%ngas
719 0 : gasnames(i) = g_list%gas(i)%camname
720 : end do
721 :
722 : end if
723 :
724 : ! Does the climate calculation use data ozone?
725 322560 : if (present(use_data_o3)) then
726 :
727 : ! get index of O3 in gas list
728 1536 : igas = rad_gas_index('O3')
729 :
730 : ! Get data source
731 1536 : source = g_list%gas(igas)%source
732 :
733 1536 : use_data_o3 = .false.
734 1536 : if (source == 'N') use_data_o3 = .true.
735 : endif
736 :
737 322560 : end subroutine rad_cnst_get_info
738 :
739 : !================================================================================================
740 :
741 0 : subroutine rad_cnst_get_info_by_mode(list_idx, m_idx, &
742 0 : mode_type, num_name, num_name_cw, nspec)
743 :
744 : ! Return info about modal aerosol lists
745 :
746 : ! Arguments
747 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
748 : integer, intent(in) :: m_idx ! index of mode in the specified list
749 : character(len=32), optional, intent(out) :: mode_type ! type of mode (as used in MAM code)
750 : character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio
751 : character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio
752 : integer, optional, intent(out) :: nspec ! number of species in the mode
753 :
754 : ! Local variables
755 : type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
756 :
757 : integer :: nmodes
758 : integer :: mm
759 :
760 : character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode'
761 : !-----------------------------------------------------------------------------
762 :
763 0 : m_list => ma_list(list_idx)
764 :
765 : ! check for valid mode index
766 0 : nmodes = m_list%nmodes
767 0 : if (m_idx < 1 .or. m_idx > nmodes) then
768 0 : write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx
769 0 : call endrun(subname//': ERROR - invalid mode index')
770 : end if
771 :
772 : ! get index into the mode definition object
773 0 : mm = m_list%idx(m_idx)
774 :
775 : ! mode type
776 0 : if (present(mode_type)) then
777 0 : mode_type = modes%types(mm)
778 : endif
779 :
780 : ! number of species in the mode
781 0 : if (present(nspec)) then
782 0 : nspec = modes%comps(mm)%nspec
783 : endif
784 :
785 : ! name of interstitial number mixing ratio
786 0 : if (present(num_name)) then
787 0 : num_name = modes%comps(mm)%camname_num_a
788 : endif
789 :
790 : ! name of cloud borne number mixing ratio
791 0 : if (present(num_name_cw)) then
792 0 : num_name_cw = modes%comps(mm)%camname_num_c
793 : endif
794 :
795 322560 : end subroutine rad_cnst_get_info_by_mode
796 :
797 : !================================================================================================
798 :
799 3900738809 : subroutine rad_cnst_get_info_by_bin(list_idx, m_idx, &
800 0 : bin_name, num_name, num_name_cw, mmr_name, mmr_name_cw, nspec)
801 :
802 : ! Return info about CARMA aerosol lists
803 :
804 : ! Arguments
805 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
806 : integer, intent(in) :: m_idx ! index of bin in the specified list
807 : character(len=*), optional, intent(out) :: bin_name
808 : character(len=32), optional, intent(out) :: num_name ! name of interstitial number mixing ratio
809 : character(len=32), optional, intent(out) :: num_name_cw ! name of cloud borne number mixing ratio
810 : character(len=32), optional, intent(out) :: mmr_name ! name of interstitial mass mixing ratio
811 : character(len=32), optional, intent(out) :: mmr_name_cw ! name of cloud borne mass mixing ratio
812 : integer, optional, intent(out) :: nspec ! number of species in the mode
813 :
814 : ! Local variables
815 : type(binlist_t), pointer :: s_list ! local pointer to mode list of interest
816 :
817 : integer :: nbins
818 : integer :: mm
819 :
820 : character(len=*), parameter :: subname = 'rad_cnst_get_info_by_bin'
821 : !-----------------------------------------------------------------------------
822 :
823 3900738809 : s_list => sa_list(list_idx)
824 :
825 : ! check for valid mode index
826 3900738809 : nbins = s_list%nbins
827 3900738809 : if (m_idx < 1 .or. m_idx > nbins) then
828 0 : write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx
829 0 : call endrun(subname//': ERROR - invalid bin index')
830 : end if
831 :
832 : ! get index into the mode definition object
833 3900738809 : mm = s_list%idx(m_idx)
834 :
835 : ! number of species in the mode
836 3900738809 : if (present(nspec)) then
837 1557626880 : nspec = bins%comps(mm)%nspec
838 : endif
839 :
840 : ! bin name
841 3900738809 : if (present(bin_name)) then
842 2298998009 : bin_name = bins%names(m_idx)
843 : end if
844 :
845 : ! name of interstitial number mixing ratio
846 3900738809 : if (present(num_name)) then
847 49950720 : num_name = bins%comps(mm)%camname_num_a
848 : endif
849 :
850 : ! name of cloud borne number mixing ratio
851 3900738809 : if (present(num_name_cw)) then
852 49950720 : num_name_cw = bins%comps(mm)%camname_num_c
853 : endif
854 :
855 : ! name of interstitial mass mixing ratio
856 3900738809 : if (present(mmr_name)) then
857 61440 : mmr_name = bins%comps(mm)%camname_mass_a
858 : endif
859 :
860 : ! name of cloud borne mass mixing ratio
861 3900738809 : if (present(mmr_name_cw)) then
862 0 : mmr_name_cw = bins%comps(mm)%camname_mass_c
863 : endif
864 :
865 0 : end subroutine rad_cnst_get_info_by_bin
866 :
867 : !================================================================================================
868 43403526259 : subroutine rad_cnst_get_info_by_bin_spec(list_idx, m_idx, s_idx, &
869 0 : spec_type, spec_morph, spec_name, spec_name_cw)
870 :
871 : ! Return info about CARMA aerosol lists
872 :
873 : ! Arguments
874 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
875 : integer, intent(in) :: m_idx ! index of bin in the specified list
876 : integer, intent(in) :: s_idx ! index of species in the specified mode
877 : character(len=32), optional, intent(out) :: spec_type ! type of species
878 : character(len=32), optional, intent(out) :: spec_morph ! type of species
879 : character(len=32), optional, intent(out) :: spec_name ! name of interstitial species
880 : character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne species
881 :
882 : ! Local variables
883 : type(binlist_t), pointer :: s_list ! local pointer to mode list of interest
884 : integer :: nbins, nspec
885 : integer :: mm
886 :
887 : character(len=*), parameter :: subname = 'rad_cnst_get_info_by_bin_spec'
888 : !-----------------------------------------------------------------------------
889 :
890 43403526259 : s_list => sa_list(list_idx)
891 :
892 : ! check for valid mode index
893 43403526259 : nbins = s_list%nbins
894 43403526259 : if (m_idx < 1 .or. m_idx > nbins) then
895 0 : write(iulog,*) subname//': ERROR - invalid bin index: ', m_idx
896 0 : call endrun(subname//': ERROR - invalid bin index')
897 : end if
898 :
899 : ! get index into the mode definition object
900 43403526259 : mm = s_list%idx(m_idx)
901 :
902 : ! check for valid species index
903 43403526259 : nspec = bins%comps(mm)%nspec
904 43403526259 : if (s_idx < 1 .or. s_idx > nspec) then
905 0 : write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx
906 0 : call endrun(subname//': ERROR - invalid specie index')
907 : end if
908 :
909 43403526259 : if (present(spec_type)) then
910 43204921459 : spec_type = bins%comps(mm)%type(s_idx)
911 : endif
912 43403526259 : if (present(spec_morph)) then
913 0 : spec_morph = bins%comps(mm)%morph(s_idx)
914 : endif
915 43403526259 : if (present(spec_name)) then
916 198282240 : spec_name = bins%comps(mm)%camname_mmr_a(s_idx)
917 : endif
918 43403526259 : if (present(spec_name_cw)) then
919 35051520 : spec_name_cw = bins%comps(mm)%camname_mmr_c(s_idx)
920 : endif
921 :
922 3900738809 : end subroutine rad_cnst_get_info_by_bin_spec
923 :
924 : !================================================================================================
925 0 : subroutine rad_cnst_get_info_by_mode_spec(list_idx, m_idx, s_idx, &
926 0 : spec_type, spec_name, spec_name_cw)
927 :
928 : ! Return info about modal aerosol lists
929 :
930 : ! Arguments
931 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
932 : integer, intent(in) :: m_idx ! index of mode in the specified list
933 : integer, intent(in) :: s_idx ! index of specie in the specified mode
934 : character(len=32), optional, intent(out) :: spec_type ! type of specie
935 : character(len=32), optional, intent(out) :: spec_name ! name of interstitial specie
936 : character(len=32), optional, intent(out) :: spec_name_cw ! name of cloud borne specie
937 :
938 : ! Local variables
939 : type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
940 :
941 : integer :: nmodes
942 : integer :: nspec
943 : integer :: mm
944 :
945 : character(len=*), parameter :: subname = 'rad_cnst_get_info_by_mode_spec'
946 : !-----------------------------------------------------------------------------
947 :
948 0 : m_list => ma_list(list_idx)
949 :
950 : ! check for valid mode index
951 0 : nmodes = m_list%nmodes
952 0 : if (m_idx < 1 .or. m_idx > nmodes) then
953 0 : write(iulog,*) subname//': ERROR - invalid mode index: ', m_idx
954 0 : call endrun(subname//': ERROR - invalid mode index')
955 : end if
956 :
957 : ! get index into the mode definition object
958 0 : mm = m_list%idx(m_idx)
959 :
960 : ! check for valid specie index
961 0 : nspec = modes%comps(mm)%nspec
962 0 : if (s_idx < 1 .or. s_idx > nspec) then
963 0 : write(iulog,*) subname//': ERROR - invalid specie index: ', s_idx
964 0 : call endrun(subname//': ERROR - invalid specie index')
965 : end if
966 :
967 : ! specie type
968 0 : if (present(spec_type)) then
969 0 : spec_type = modes%comps(mm)%type(s_idx)
970 : endif
971 :
972 : ! interstitial specie name
973 0 : if (present(spec_name)) then
974 0 : spec_name = modes%comps(mm)%camname_mmr_a(s_idx)
975 : endif
976 :
977 : ! cloud borne specie name
978 0 : if (present(spec_name_cw)) then
979 0 : spec_name_cw = modes%comps(mm)%camname_mmr_c(s_idx)
980 : endif
981 :
982 43403526259 : end subroutine rad_cnst_get_info_by_mode_spec
983 :
984 : !================================================================================================
985 :
986 0 : subroutine rad_cnst_get_info_by_spectype(list_idx, spectype, mode_idx, spec_idx)
987 :
988 : ! Return info about modes in the specified climate/diagnostics list
989 :
990 : ! Arguments
991 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
992 : character(len=*), intent(in) :: spectype ! species type
993 : integer, optional, intent(out) :: mode_idx ! index of a mode that contains a specie of spectype
994 : integer, optional, intent(out) :: spec_idx ! index of the species of spectype
995 :
996 : ! Local variables
997 : type(modelist_t), pointer :: m_list ! local pointer to mode list of interest
998 :
999 : integer :: i, nmodes, m_idx, nspec, ispec
1000 : logical :: found_spectype
1001 :
1002 : character(len=*), parameter :: subname = 'rad_cnst_get_info_by_spectype'
1003 : !-----------------------------------------------------------------------------
1004 :
1005 0 : m_list => ma_list(list_idx)
1006 :
1007 : ! number of modes in specified list
1008 0 : nmodes = m_list%nmodes
1009 :
1010 : ! loop through modes in specified climate/diagnostic list
1011 0 : found_spectype = .false.
1012 0 : do i = 1, nmodes
1013 :
1014 : ! get index of the mode in the definition object
1015 0 : m_idx = m_list%idx(i)
1016 :
1017 : ! number of species in the mode
1018 0 : nspec = modes%comps(m_idx)%nspec
1019 :
1020 : ! loop through species looking for spectype
1021 0 : do ispec = 1, nspec
1022 :
1023 0 : if (trim(modes%comps(m_idx)%type(ispec)) == trim(spectype)) then
1024 0 : if (present(mode_idx)) mode_idx = i
1025 0 : if (present(spec_idx)) spec_idx = ispec
1026 0 : found_spectype = .true.
1027 0 : exit
1028 : end if
1029 : end do
1030 :
1031 0 : if (found_spectype) exit
1032 : end do
1033 :
1034 0 : if (.not. found_spectype) then
1035 0 : if (present(mode_idx)) mode_idx = -1
1036 0 : if (present(spec_idx)) spec_idx = -1
1037 : end if
1038 :
1039 0 : end subroutine rad_cnst_get_info_by_spectype
1040 :
1041 : !================================================================================================
1042 :
1043 0 : function rad_cnst_get_mode_idx(list_idx, mode_type) result(mode_idx)
1044 :
1045 : ! Return mode index of the specified type in the specified climate/diagnostics list.
1046 : ! Return -1 if not found.
1047 :
1048 : ! Arguments
1049 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
1050 : character(len=*), intent(in) :: mode_type ! mode type
1051 :
1052 : ! Return value
1053 : integer :: mode_idx ! mode index
1054 :
1055 : ! Local variables
1056 : type(modelist_t), pointer :: m_list
1057 :
1058 : integer :: i, nmodes, m_idx
1059 :
1060 : character(len=*), parameter :: subname = 'rad_cnst_get_mode_idx'
1061 : !-----------------------------------------------------------------------------
1062 :
1063 : ! if mode type not found return -1
1064 0 : mode_idx = -1
1065 :
1066 : ! specified mode list
1067 0 : m_list => ma_list(list_idx)
1068 :
1069 : ! number of modes in specified list
1070 0 : nmodes = m_list%nmodes
1071 :
1072 : ! loop through modes in specified climate/diagnostic list
1073 0 : do i = 1, nmodes
1074 :
1075 : ! get index of the mode in the definition object
1076 0 : m_idx = m_list%idx(i)
1077 :
1078 : ! look in mode definition object (modes) for the mode types
1079 0 : if (trim(modes%types(m_idx)) == trim(mode_type)) then
1080 0 : mode_idx = i
1081 0 : exit
1082 : end if
1083 : end do
1084 :
1085 0 : end function rad_cnst_get_mode_idx
1086 :
1087 : !================================================================================================
1088 :
1089 0 : function rad_cnst_get_spec_idx(list_idx, mode_idx, spec_type) result(spec_idx)
1090 :
1091 : ! Return specie index of the specified type in the specified mode of the specified
1092 : ! climate/diagnostics list. Return -1 if not found.
1093 :
1094 : ! Arguments
1095 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
1096 : integer, intent(in) :: mode_idx ! mode index
1097 : character(len=*), intent(in) :: spec_type ! specie type
1098 :
1099 : ! Return value
1100 : integer :: spec_idx ! specie index
1101 :
1102 : ! Local variables
1103 : type(modelist_t), pointer :: m_list
1104 : type(mode_component_t), pointer :: mode_comps
1105 :
1106 : integer :: i, m_idx, nspec
1107 :
1108 : character(len=*), parameter :: subname = 'rad_cnst_get_spec_idx'
1109 : !-----------------------------------------------------------------------------
1110 :
1111 : ! if specie type not found return -1
1112 0 : spec_idx = -1
1113 :
1114 : ! modes in specified list
1115 0 : m_list => ma_list(list_idx)
1116 :
1117 : ! get index of the specified mode in the definition object
1118 0 : m_idx = m_list%idx(mode_idx)
1119 :
1120 : ! object containing the components of the mode
1121 0 : mode_comps => modes%comps(m_idx)
1122 :
1123 : ! number of species in specified mode
1124 0 : nspec = mode_comps%nspec
1125 :
1126 : ! loop through species in specified mode
1127 0 : do i = 1, nspec
1128 :
1129 : ! look in mode definition object (modes) for the mode types
1130 0 : if (trim(mode_comps%type(i)) == trim(spec_type)) then
1131 0 : spec_idx = i
1132 0 : exit
1133 : end if
1134 : end do
1135 :
1136 0 : end function rad_cnst_get_spec_idx
1137 :
1138 : !================================================================================================
1139 :
1140 79872 : subroutine rad_cnst_get_call_list(call_list)
1141 :
1142 : ! Return info about which climate/diagnostic calculations are requested
1143 :
1144 : ! Arguments
1145 : logical, intent(out) :: call_list(0:N_DIAG)
1146 : !-----------------------------------------------------------------------------
1147 :
1148 79872 : call_list(:) = active_calls(:)
1149 :
1150 79872 : end subroutine rad_cnst_get_call_list
1151 :
1152 : !================================================================================================
1153 :
1154 38400 : subroutine rad_cnst_out(list_idx, state, pbuf)
1155 :
1156 : ! Output the mass per layer, and total column burdens for gas and aerosol
1157 : ! constituents in either the climate or diagnostic lists
1158 :
1159 : ! Arguments
1160 : integer, intent(in) :: list_idx
1161 : type(physics_state), target, intent(in) :: state
1162 : type(physics_buffer_desc), pointer :: pbuf(:)
1163 :
1164 :
1165 : ! Local variables
1166 : integer :: i, naer, ngas, lchnk, ncol
1167 : integer :: idx
1168 : character(len=1) :: source
1169 : character(len=32) :: name, cbname
1170 : real(r8) :: mass(pcols,pver)
1171 : real(r8) :: cb(pcols)
1172 38400 : real(r8), pointer :: mmr(:,:)
1173 : type(aerlist_t), pointer :: aerlist
1174 : type(gaslist_t), pointer :: g_list
1175 : character(len=*), parameter :: subname = 'rad_cnst_out'
1176 : !-----------------------------------------------------------------------------
1177 :
1178 38400 : lchnk = state%lchnk
1179 38400 : ncol = state%ncol
1180 :
1181 : ! Associate pointer with requested aerosol list
1182 38400 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
1183 38400 : aerlist => aerosollist(list_idx)
1184 : else
1185 0 : write(iulog,*) subname//': list_idx = ', list_idx
1186 0 : call endrun(subname//': list_idx out of range')
1187 : endif
1188 :
1189 38400 : naer = aerlist%numaerosols
1190 38400 : do i = 1, naer
1191 :
1192 0 : source = aerlist%aer(i)%source
1193 0 : idx = aerlist%aer(i)%idx
1194 0 : name = aerlist%aer(i)%mass_name
1195 : ! construct name for column burden field by replacing the 'm_' prefix by 'cb_'
1196 0 : cbname = 'cb_' // name(3:len_trim(name))
1197 :
1198 0 : select case( source )
1199 : case ('A')
1200 0 : mmr => state%q(:,:,idx)
1201 : case ('N')
1202 0 : call pbuf_get_field(pbuf, idx, mmr)
1203 : end select
1204 :
1205 0 : mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
1206 0 : call outfld(trim(name), mass, pcols, lchnk)
1207 :
1208 0 : cb(:ncol) = sum(mass(:ncol,:),2)
1209 38400 : call outfld(trim(cbname), cb, pcols, lchnk)
1210 :
1211 : end do
1212 :
1213 : ! Associate pointer with requested gas list
1214 38400 : g_list => gaslist(list_idx)
1215 :
1216 38400 : ngas = g_list%ngas
1217 345600 : do i = 1, ngas
1218 :
1219 307200 : source = g_list%gas(i)%source
1220 307200 : idx = g_list%gas(i)%idx
1221 307200 : name = g_list%gas(i)%mass_name
1222 307200 : cbname = 'cb_' // name(3:len_trim(name))
1223 192000 : select case( source )
1224 : case ('A')
1225 192000 : mmr => state%q(:,:,idx)
1226 : case ('N')
1227 307200 : call pbuf_get_field(pbuf, idx, mmr)
1228 : end select
1229 :
1230 331468800 : mass(:ncol,:) = mmr(:ncol,:) * state%pdeldry(:ncol,:) * rga
1231 307200 : call outfld(trim(name), mass, pcols, lchnk)
1232 :
1233 314388480 : cb(:ncol) = sum(mass(:ncol,:),2)
1234 345600 : call outfld(trim(cbname), cb, pcols, lchnk)
1235 :
1236 : end do
1237 :
1238 38400 : end subroutine rad_cnst_out
1239 :
1240 : !================================================================================================
1241 : ! Private methods
1242 : !================================================================================================
1243 :
1244 1536 : subroutine init_mode_comps(modes)
1245 :
1246 : ! Initialize the mode definitions by looking up the relevent indices in the
1247 : ! constituent and pbuf arrays, and getting the physprop IDs
1248 :
1249 : ! Arguments
1250 : type(modes_t), intent(inout) :: modes
1251 :
1252 : ! Local variables
1253 : integer :: m, ispec, nspec
1254 :
1255 : character(len=*), parameter :: routine = 'init_mode_comps'
1256 : !-----------------------------------------------------------------------------
1257 :
1258 1536 : do m = 1, modes%nmodes
1259 :
1260 : ! indices for number mixing ratio components
1261 0 : modes%comps(m)%idx_num_a = get_cam_idx(modes%comps(m)%source_num_a, modes%comps(m)%camname_num_a, routine)
1262 0 : modes%comps(m)%idx_num_c = get_cam_idx(modes%comps(m)%source_num_c, modes%comps(m)%camname_num_c, routine)
1263 :
1264 : ! allocate memory for species
1265 0 : nspec = modes%comps(m)%nspec
1266 : allocate( &
1267 : modes%comps(m)%idx_mmr_a(nspec), &
1268 0 : modes%comps(m)%idx_mmr_c(nspec), &
1269 0 : modes%comps(m)%idx_props(nspec) )
1270 :
1271 1536 : do ispec = 1, nspec
1272 :
1273 : ! indices for species mixing ratio components
1274 0 : modes%comps(m)%idx_mmr_a(ispec) = get_cam_idx(modes%comps(m)%source_mmr_a(ispec), &
1275 0 : modes%comps(m)%camname_mmr_a(ispec), routine)
1276 0 : modes%comps(m)%idx_mmr_c(ispec) = get_cam_idx(modes%comps(m)%source_mmr_c(ispec), &
1277 0 : modes%comps(m)%camname_mmr_c(ispec), routine)
1278 :
1279 : ! get physprop ID
1280 0 : modes%comps(m)%idx_props(ispec) = physprop_get_id(modes%comps(m)%props(ispec))
1281 0 : if (modes%comps(m)%idx_props(ispec) == -1) then
1282 0 : call endrun(routine//' : ERROR idx not found for '//trim(modes%comps(m)%props(ispec)))
1283 : end if
1284 :
1285 : end do
1286 :
1287 : end do
1288 :
1289 1536 : end subroutine init_mode_comps
1290 :
1291 : !================================================================================================
1292 :
1293 1536 : subroutine init_bin_comps(bins)
1294 :
1295 : ! Initialize the mode definitions by looking up the relevent indices in the
1296 : ! constituent and pbuf arrays, and getting the physprop IDs
1297 :
1298 : ! Arguments
1299 : type(bins_t), intent(inout) :: bins
1300 :
1301 : ! Local variables
1302 : integer :: m, ispec, nspec
1303 :
1304 : character(len=*), parameter :: routine = 'init_bin_comps'
1305 : !-----------------------------------------------------------------------------
1306 :
1307 62976 : do m = 1, bins%nbins
1308 :
1309 : ! indices for number mixing ratio components
1310 61440 : bins%comps(m)%idx_num_a = get_cam_idx(bins%comps(m)%source_num_a, bins%comps(m)%camname_num_a, routine)
1311 61440 : bins%comps(m)%idx_num_c = get_cam_idx(bins%comps(m)%source_num_c, bins%comps(m)%camname_num_c, routine)
1312 61440 : if ( bins%comps(m)%source_mass_a /= 'NOTSET' .and. bins%comps(m)%camname_mass_a /= 'NOTSET' ) then
1313 0 : bins%comps(m)%idx_mass_a = get_cam_idx(bins%comps(m)%source_mass_a, bins%comps(m)%camname_mass_a, routine)
1314 : endif
1315 61440 : if ( bins%comps(m)%source_mass_c /= 'NOTSET' .and. bins%comps(m)%camname_mass_c /= 'NOTSET' ) then
1316 0 : bins%comps(m)%idx_mass_c = get_cam_idx(bins%comps(m)%source_mass_c, bins%comps(m)%camname_mass_c, routine)
1317 : endif
1318 :
1319 : ! allocate memory for species
1320 61440 : nspec = bins%comps(m)%nspec
1321 : allocate( &
1322 : bins%comps(m)%idx_mmr_a(nspec), &
1323 0 : bins%comps(m)%idx_mmr_c(nspec), &
1324 307200 : bins%comps(m)%idx_props(nspec) )
1325 :
1326 278016 : do ispec = 1, nspec
1327 :
1328 : ! indices for species mixing ratio components
1329 0 : bins%comps(m)%idx_mmr_a(ispec) = get_cam_idx(bins%comps(m)%source_mmr_a(ispec), &
1330 215040 : bins%comps(m)%camname_mmr_a(ispec), routine)
1331 0 : bins%comps(m)%idx_mmr_c(ispec) = get_cam_idx(bins%comps(m)%source_mmr_c(ispec), &
1332 215040 : bins%comps(m)%camname_mmr_c(ispec), routine)
1333 :
1334 : ! get physprop ID
1335 215040 : bins%comps(m)%idx_props(ispec) = physprop_get_id(bins%comps(m)%props(ispec))
1336 276480 : if (bins%comps(m)%idx_props(ispec) == -1) then
1337 0 : call endrun(routine//' : ERROR idx not found for '//trim(bins%comps(m)%props(ispec)))
1338 : end if
1339 :
1340 : end do
1341 :
1342 : end do
1343 :
1344 1536 : end subroutine init_bin_comps
1345 :
1346 : !================================================================================================
1347 :
1348 565248 : integer function get_cam_idx(source, name, routine)
1349 :
1350 : ! get index of name in internal CAM array; either the constituent array
1351 : ! or the physics buffer
1352 :
1353 : character(len=*), intent(in) :: source
1354 : character(len=*), intent(in) :: name
1355 : character(len=*), intent(in) :: routine ! name of calling routine
1356 :
1357 : integer :: idx
1358 : integer :: errcode
1359 : !-----------------------------------------------------------------------------
1360 :
1361 565248 : if (source(1:1) == 'N') then
1362 :
1363 342528 : idx = pbuf_get_index(trim(name),errcode)
1364 342528 : if (errcode < 0) then
1365 0 : call endrun(routine//' ERROR: cannot find physics buffer field '//trim(name))
1366 : end if
1367 :
1368 222720 : else if (source(1:1) == 'A') then
1369 :
1370 222720 : call cnst_get_ind(trim(name), idx, abort=.false.)
1371 222720 : if (idx < 0) then
1372 0 : call endrun(routine//' ERROR: cannot find constituent field '//trim(name))
1373 : end if
1374 :
1375 0 : else if (source(1:1) == 'Z') then
1376 :
1377 0 : idx = -1
1378 :
1379 : else
1380 :
1381 0 : call endrun(routine//' ERROR: invalid source for specie '//trim(name))
1382 :
1383 : end if
1384 :
1385 565248 : get_cam_idx = idx
1386 :
1387 565248 : end function get_cam_idx
1388 :
1389 : !================================================================================================
1390 :
1391 1536 : subroutine list_init1(namelist, gaslist, aerlist, ma_list, sa_list)
1392 :
1393 : ! Initialize the gas and bulk and modal aerosol lists with the
1394 : ! entities specified in the climate or diagnostic lists.
1395 :
1396 : ! This first phase initialization just sets the information that
1397 : ! is available at the time the namelist is read.
1398 :
1399 : type(rad_cnst_namelist_t), intent(in) :: namelist ! parsed namelist input for climate or diagnostic lists
1400 :
1401 : type(gaslist_t), intent(inout) :: gaslist
1402 : type(aerlist_t), intent(inout) :: aerlist
1403 : type(modelist_t), intent(inout) :: ma_list
1404 : type(binlist_t), intent(inout) :: sa_list
1405 :
1406 : ! Local variables
1407 : integer :: ii, m, naero, nmodes, nbins
1408 : integer :: igas, ba_idx, ma_idx, sa_idx
1409 : integer :: istat
1410 : character(len=*), parameter :: routine = 'list_init1'
1411 : !-----------------------------------------------------------------------------
1412 :
1413 : ! nradgas is set by the radiative transfer code
1414 1536 : gaslist%ngas = nradgas
1415 :
1416 : ! Determine the number of bulk aerosols and aerosol modes in the list
1417 1536 : naero = 0
1418 1536 : nmodes = 0
1419 1536 : nbins = 0
1420 75264 : do ii = 1, namelist%ncnst
1421 73728 : if (trim(namelist%type(ii)) == 'A') naero = naero + 1
1422 73728 : if (trim(namelist%type(ii)) == 'M') nmodes = nmodes + 1
1423 75264 : if (trim(namelist%type(ii)) == 'B') nbins = nbins + 1
1424 : end do
1425 1536 : aerlist%numaerosols = naero
1426 1536 : ma_list%nmodes = nmodes
1427 1536 : sa_list%nbins = nbins
1428 :
1429 : ! allocate storage for the aerosol, gas, and mode lists
1430 : allocate( &
1431 : aerlist%aer(aerlist%numaerosols), &
1432 : gaslist%gas(gaslist%ngas), &
1433 : ma_list%idx(ma_list%nmodes), &
1434 : ma_list%physprop_files(ma_list%nmodes), &
1435 : ma_list%idx_props(ma_list%nmodes), &
1436 : sa_list%idx(sa_list%nbins), &
1437 : sa_list%physprop_files(sa_list%nbins), &
1438 : sa_list%idx_props(sa_list%nbins), &
1439 16896 : stat=istat)
1440 1536 : if (istat /= 0) call endrun(routine//': allocate ERROR; aero and gas list components')
1441 :
1442 1536 : if (masterproc .and. verbose) then
1443 2 : if (len_trim(gaslist%list_id) == 0) then
1444 2 : write(iulog,*) nl//' '//routine//': namelist input for climate list'
1445 : else
1446 0 : write(iulog,*) nl//' '//routine//': namelist input for diagnostic list:'//gaslist%list_id
1447 : end if
1448 : end if
1449 :
1450 : ! Loop over the radiatively active components specified in the namelist
1451 1536 : ba_idx = 0
1452 1536 : ma_idx = 0
1453 1536 : sa_idx = 0
1454 75264 : do ii = 1, namelist%ncnst
1455 :
1456 73728 : if (masterproc .and. verbose) &
1457 0 : write(iulog,*) " rad namelist spec: "// trim(namelist%source(ii)) &
1458 96 : //":"//trim(namelist%camname(ii))//":"//trim(namelist%radname(ii))
1459 :
1460 : ! Check that the source specifier is legal.
1461 0 : if (namelist%source(ii) /= 'A' .and. namelist%source(ii) /= 'M' .and. &
1462 73728 : namelist%source(ii) /= 'N' .and. namelist%source(ii) /= 'Z' .and. &
1463 : namelist%source(ii) /= 'B' ) then
1464 : call endrun(routine//": source must either be A, B, M, N or Z:"//&
1465 0 : " illegal specifier in namelist input: "//namelist%source(ii))
1466 : end if
1467 :
1468 : ! Add component to appropriate list (gas, modal or bulk aerosol)
1469 75264 : if (namelist%type(ii) == 'A') then
1470 :
1471 : ! Add to bulk aerosol list
1472 0 : ba_idx = ba_idx + 1
1473 :
1474 0 : aerlist%aer(ba_idx)%source = namelist%source(ii)
1475 0 : aerlist%aer(ba_idx)%camname = namelist%camname(ii)
1476 0 : aerlist%aer(ba_idx)%physprop_file = namelist%radname(ii)
1477 :
1478 73728 : else if (namelist%type(ii) == 'M') then
1479 :
1480 : ! Add to modal aerosol list
1481 0 : ma_idx = ma_idx + 1
1482 :
1483 : ! Look through the mode definitions for the name of the specified mode. The
1484 : ! index into the modes object all the information relevent to the mode definition.
1485 0 : ma_list%idx(ma_idx) = -1
1486 0 : do m = 1, modes%nmodes
1487 0 : if (trim(namelist%camname(ii)) == trim(modes%names(m))) then
1488 0 : ma_list%idx(ma_idx) = m
1489 0 : exit
1490 : end if
1491 : end do
1492 0 : if (ma_list%idx(ma_idx) == -1) &
1493 0 : call endrun(routine//' ERROR cannot find mode name '//trim(namelist%camname(ii)))
1494 :
1495 : ! Also save the name of the physprop file
1496 0 : ma_list%physprop_files(ma_idx) = namelist%radname(ii)
1497 :
1498 73728 : else if (namelist%type(ii) == 'B') then
1499 :
1500 : ! Add to modal aerosol list
1501 61440 : sa_idx = sa_idx + 1
1502 :
1503 : ! Look through the bin definitions for the name of the specified bin. The
1504 : ! index into the modes object all the information relevent to the mode definition.
1505 61440 : sa_list%idx(sa_idx) = -1
1506 1259520 : do m = 1, bins%nbins
1507 1259520 : if (trim(namelist%camname(ii)) == trim(bins%names(m))) then
1508 61440 : sa_list%idx(sa_idx) = m
1509 61440 : exit
1510 : end if
1511 : end do
1512 61440 : if (sa_list%idx(sa_idx) == -1) &
1513 0 : call endrun(routine//' ERROR cannot find bin name '//trim(namelist%camname(ii)))
1514 :
1515 : ! Also save the name of the physprop file
1516 61440 : sa_list%physprop_files(sa_idx) = namelist%radname(ii)
1517 :
1518 : else
1519 :
1520 : ! Add to gas list
1521 :
1522 : ! The radiative transfer code requires the input of a specific set of gases
1523 : ! which is hardwired into the code. The CAM interface to the RT code uses
1524 : ! the names in the radconstants module to refer to these gases. The user
1525 : ! interface (namelist) also uses these names to identify the gases treated
1526 : ! by the RT code. We use the index order set in radconstants for convenience
1527 : ! only.
1528 :
1529 : ! First check that the gas name specified by the user is allowed.
1530 : ! rad_gas_index will abort on illegal names.
1531 12288 : igas = rad_gas_index(namelist%radname(ii))
1532 :
1533 : ! Set values in the igas index
1534 12288 : gaslist%gas(igas)%source = namelist%source(ii)
1535 12288 : gaslist%gas(igas)%camname = namelist%camname(ii)
1536 :
1537 : end if
1538 : end do
1539 :
1540 1536 : end subroutine list_init1
1541 :
1542 : !================================================================================================
1543 :
1544 1536 : subroutine list_init2(gaslist, aerlist, ma_list, sa_list)
1545 :
1546 : ! Final initialization phase gets the component indices in the constituent array
1547 : ! and the physics buffer, and indices into physprop module.
1548 :
1549 : type(gaslist_t), intent(inout) :: gaslist
1550 : type(aerlist_t), intent(inout) :: aerlist
1551 : type(modelist_t), intent(inout) :: ma_list
1552 : type(binlist_t), intent(inout) :: sa_list
1553 :
1554 : ! Local variables
1555 : integer :: i
1556 : character(len=*), parameter :: routine = 'list_init2'
1557 : !-----------------------------------------------------------------------------
1558 :
1559 : ! Loop over gases
1560 13824 : do i = 1, gaslist%ngas
1561 :
1562 : ! locate the specie mixing ratio in the pbuf or state
1563 13824 : gaslist%gas(i)%idx = get_cam_idx(gaslist%gas(i)%source, gaslist%gas(i)%camname, routine)
1564 :
1565 : end do
1566 :
1567 : ! Loop over bulk aerosols
1568 1536 : do i = 1, aerlist%numaerosols
1569 :
1570 : ! locate the specie mixing ratio in the pbuf or state
1571 0 : aerlist%aer(i)%idx = get_cam_idx(aerlist%aer(i)%source, aerlist%aer(i)%camname, routine)
1572 :
1573 : ! get the physprop_id from the phys_prop module
1574 1536 : aerlist%aer(i)%physprop_id = physprop_get_id(aerlist%aer(i)%physprop_file)
1575 :
1576 : end do
1577 :
1578 : ! Loop over modes
1579 1536 : do i = 1, ma_list%nmodes
1580 :
1581 : ! get the physprop_id from the phys_prop module
1582 1536 : ma_list%idx_props(i) = physprop_get_id(ma_list%physprop_files(i))
1583 :
1584 : end do
1585 :
1586 : ! Loop over bins
1587 62976 : do i = 1, sa_list%nbins
1588 :
1589 : ! get the physprop_id from the phys_prop module
1590 62976 : sa_list%idx_props(i) = physprop_get_id(sa_list%physprop_files(i))
1591 :
1592 : end do
1593 :
1594 1536 : end subroutine list_init2
1595 :
1596 : !================================================================================================
1597 :
1598 1536 : subroutine rad_gas_diag_init(glist)
1599 :
1600 : ! Add diagnostic fields to the master fieldlist.
1601 :
1602 : type(gaslist_t), intent(inout) :: glist
1603 :
1604 : integer :: i, ngas
1605 : character(len=64) :: name
1606 : character(len=2) :: list_id
1607 : character(len=4) :: suffix
1608 : character(len=128):: long_name
1609 : character(len=32) :: long_name_description
1610 : !-----------------------------------------------------------------------------
1611 :
1612 1536 : ngas = glist%ngas
1613 1536 : if (ngas == 0) return
1614 :
1615 : ! Determine whether this is a climate or diagnostic list.
1616 1536 : list_id = glist%list_id
1617 1536 : if (len_trim(list_id) == 0) then
1618 1536 : suffix = '_c'
1619 1536 : long_name_description = ' used in climate calculation'
1620 : else
1621 0 : suffix = '_d' // list_id
1622 0 : long_name_description = ' used in diagnostic calculation'
1623 : end if
1624 :
1625 13824 : do i = 1, ngas
1626 :
1627 : ! construct names for mass per layer diagnostics
1628 12288 : name = 'm_' // trim(glist%gas(i)%camname) // trim(suffix)
1629 12288 : glist%gas(i)%mass_name = name
1630 12288 : long_name = trim(glist%gas(i)%camname)//' mass per layer'//long_name_description
1631 24576 : call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name))
1632 :
1633 : ! construct names for column burden diagnostics
1634 12288 : name = 'cb_' // trim(glist%gas(i)%camname) // trim(suffix)
1635 12288 : long_name = trim(glist%gas(i)%camname)//' column burden'//long_name_description
1636 12288 : call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name))
1637 :
1638 : ! error check for name length
1639 13824 : if (len_trim(name) > fieldname_len) then
1640 0 : write(iulog,*) 'rad_gas_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters'
1641 0 : call endrun('rad_gas_diag_init: name too long: '//trim(name))
1642 : end if
1643 :
1644 : end do
1645 :
1646 : end subroutine rad_gas_diag_init
1647 :
1648 : !================================================================================================
1649 :
1650 1536 : subroutine rad_aer_diag_init(alist)
1651 :
1652 : ! Add diagnostic fields to the master fieldlist.
1653 :
1654 : type(aerlist_t), intent(inout) :: alist
1655 :
1656 : integer :: i, naer
1657 : character(len=64) :: name
1658 : character(len=2) :: list_id
1659 : character(len=4) :: suffix
1660 : character(len=128):: long_name
1661 : character(len=32) :: long_name_description
1662 : !-----------------------------------------------------------------------------
1663 :
1664 1536 : naer = alist%numaerosols
1665 1536 : if (naer == 0) return
1666 :
1667 : ! Determine whether this is a climate or diagnostic list.
1668 0 : list_id = alist%list_id
1669 0 : if (len_trim(list_id) == 0) then
1670 0 : suffix = '_c'
1671 0 : long_name_description = ' used in climate calculation'
1672 : else
1673 0 : suffix = '_d' // list_id
1674 0 : long_name_description = ' used in diagnostic calculation'
1675 : end if
1676 :
1677 0 : do i = 1, naer
1678 :
1679 : ! construct names for mass per layer diagnostic fields
1680 0 : name = 'm_' // trim(alist%aer(i)%camname) // trim(suffix)
1681 0 : alist%aer(i)%mass_name = name
1682 0 : long_name = trim(alist%aer(i)%camname)//' mass per layer'//long_name_description
1683 0 : call addfld(trim(name), (/ 'lev' /), 'A', 'kg/m^2', trim(long_name))
1684 :
1685 : ! construct names for column burden diagnostic fields
1686 0 : name = 'cb_' // trim(alist%aer(i)%camname) // trim(suffix)
1687 0 : long_name = trim(alist%aer(i)%camname)//' column burden'//long_name_description
1688 0 : call addfld(trim(name), horiz_only, 'A', 'kg/m^2', trim(long_name))
1689 :
1690 : ! error check for name length
1691 0 : if (len_trim(name) > fieldname_len) then
1692 0 : write(iulog,*) 'rad_aer_diag_init: '//trim(name)//' longer than ', fieldname_len, ' characters'
1693 0 : call endrun('rad_aer_diag_init: name too long: '//trim(name))
1694 : end if
1695 :
1696 : end do
1697 :
1698 : end subroutine rad_aer_diag_init
1699 :
1700 :
1701 : !================================================================================================
1702 :
1703 1536 : subroutine parse_mode_defs(nl_in, modes)
1704 :
1705 : ! Parse the mode definition specifiers. The specifiers are of the form:
1706 : !
1707 : ! 'mode_name:mode_type:=',
1708 : ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+',
1709 : ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,]
1710 : ! ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+][']
1711 : !
1712 : ! where the ':' separated fields are:
1713 : ! mode_name -- name of the mode.
1714 : ! mode_type -- type of mode. Valid values are from the MAM code.
1715 : ! = -- this line terminator identifies the initial string in a
1716 : ! mode definition
1717 : ! + -- this line terminator indicates that the mode definition is
1718 : ! continued in the next string
1719 : ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z'
1720 : ! camname_num_a -- the name of the interstitial number component. This name must be
1721 : ! registered in the constituent arrays when source=A or in the
1722 : ! physics buffer when source=N
1723 : ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z'
1724 : ! camname_num_c -- the name of the cloud borne number component. This name must be
1725 : ! registered in the constituent arrays when source=A or in the
1726 : ! physics buffer when source=N
1727 : ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z'
1728 : ! camname_mmr_a -- the name of the interstitial specie. This name must be
1729 : ! registered in the constituent arrays when source=A or in the
1730 : ! physics buffer when source=N
1731 : ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z'
1732 : ! camname_mmr_c -- the name of the cloud borne specie. This name must be
1733 : ! registered in the constituent arrays when source=A or in the
1734 : ! physics buffer when source=N
1735 : ! spec_type -- species type. Valid values far from the MAM code, except that
1736 : ! the value 'num_mr' designates a number mixing ratio and has no
1737 : ! associated field for the prop_file. There can only be one entry
1738 : ! with the num_mr type in a mode definition.
1739 : ! prop_file -- For aerosol species this is a filename, which is
1740 : ! identified by a ".nc" suffix. The file contains optical and
1741 : ! other physical properties of the aerosol.
1742 : !
1743 : ! A mode definition must contain only 1 string for the number mixing ratio components
1744 : ! and at least 1 string for the species.
1745 :
1746 :
1747 : character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output)
1748 : type(modes_t), intent(inout) :: modes ! structure containing parsed input
1749 :
1750 : ! Local variables
1751 : integer :: m
1752 : integer :: istat
1753 : integer :: nmodes, nstr
1754 : integer :: mbeg, mcur
1755 : integer :: nspec, ispec
1756 : integer :: strlen, iend, ipos
1757 : logical :: num_mr_found
1758 : character(len=*), parameter :: routine = 'parse_mode_defs'
1759 1536 : character(len=len(nl_in(1))) :: tmpstr
1760 : character(len=1) :: tmp_src_a
1761 : character(len=32) :: tmp_name_a
1762 : character(len=1) :: tmp_src_c
1763 : character(len=32) :: tmp_name_c
1764 : character(len=32) :: tmp_type
1765 : !-------------------------------------------------------------------------
1766 :
1767 : ! Determine number of modes defined by counting number of strings that are
1768 : ! terminated by ':='
1769 : ! (algorithm stops counting at first blank element).
1770 1536 : nmodes = 0
1771 1536 : nstr = 0
1772 1536 : do m = 1, n_mode_str
1773 :
1774 1536 : if (len_trim(nl_in(m)) == 0) exit
1775 0 : nstr = nstr + 1
1776 :
1777 : ! There are no fields in the input strings in which a blank character is allowed.
1778 : ! To simplify the parsing go through the input strings and remove blanks.
1779 0 : tmpstr = adjustl(nl_in(m))
1780 0 : nl_in(m) = tmpstr
1781 : do
1782 0 : strlen = len_trim(nl_in(m))
1783 0 : ipos = index(nl_in(m), ' ')
1784 0 : if (ipos == 0 .or. ipos > strlen) exit
1785 0 : tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen)
1786 0 : nl_in(m) = tmpstr
1787 : end do
1788 : ! count strings with ':=' terminator
1789 1536 : if (nl_in(m)(strlen-1:strlen) == ':=') nmodes = nmodes + 1
1790 :
1791 : end do
1792 1536 : modes%nmodes = nmodes
1793 :
1794 : ! return if no modes defined
1795 1536 : if (nmodes == 0) return
1796 :
1797 : ! allocate components that depend on nmodes
1798 : allocate( &
1799 : modes%names(nmodes), &
1800 : modes%types(nmodes), &
1801 : modes%comps(nmodes), &
1802 0 : stat=istat )
1803 0 : if (istat > 0) then
1804 0 : write(iulog,*) routine//': ERROR: cannot allocate storage for modes. nmodes=', nmodes
1805 0 : call endrun(routine//': ERROR allocating storage for modes')
1806 : end if
1807 :
1808 0 : mcur = 1 ! index of current string being processed
1809 :
1810 : ! loop over modes
1811 0 : do m = 1, nmodes
1812 :
1813 0 : mbeg = mcur ! remember the first string of a mode
1814 :
1815 : ! check that first string in mode definition is ':=' terminated
1816 0 : iend = len_trim(nl_in(mcur))
1817 0 : if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur))
1818 :
1819 : ! count species in mode definition. definition will contain 1 string with
1820 : ! with a ':+' terminator for each specie
1821 0 : nspec = 0
1822 0 : mcur = mcur + 1
1823 0 : do
1824 0 : iend = len_trim(nl_in(mcur))
1825 0 : if (nl_in(mcur)(iend-1:iend) /= ':+') exit
1826 0 : nspec = nspec + 1
1827 0 : mcur = mcur + 1
1828 : end do
1829 :
1830 : ! a mode must have at least one specie
1831 0 : if (nspec == 0) call parse_error('mode must have at least one specie', nl_in(mbeg))
1832 :
1833 : ! allocate components that depend on number of species
1834 : allocate( &
1835 0 : modes%comps(m)%source_mmr_a(nspec), &
1836 0 : modes%comps(m)%camname_mmr_a(nspec), &
1837 0 : modes%comps(m)%source_mmr_c(nspec), &
1838 0 : modes%comps(m)%camname_mmr_c(nspec), &
1839 0 : modes%comps(m)%type(nspec), &
1840 0 : modes%comps(m)%props(nspec), &
1841 0 : stat=istat)
1842 :
1843 0 : if (istat > 0) then
1844 0 : write(iulog,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec
1845 0 : call endrun(routine//': ERROR allocating storage for species')
1846 : end if
1847 :
1848 : ! initialize components
1849 0 : modes%comps(m)%nspec = nspec
1850 0 : modes%comps(m)%source_num_a = ' '
1851 0 : modes%comps(m)%camname_num_a = ' '
1852 0 : modes%comps(m)%source_num_c = ' '
1853 0 : modes%comps(m)%camname_num_c = ' '
1854 0 : do ispec = 1, nspec
1855 0 : modes%comps(m)%source_mmr_a(ispec) = ' '
1856 0 : modes%comps(m)%camname_mmr_a(ispec) = ' '
1857 0 : modes%comps(m)%source_mmr_c(ispec) = ' '
1858 0 : modes%comps(m)%camname_mmr_c(ispec) = ' '
1859 0 : modes%comps(m)%type(ispec) = ' '
1860 0 : modes%comps(m)%props(ispec) = ' '
1861 : end do
1862 :
1863 : ! return to first string in mode definition
1864 0 : mcur = mbeg
1865 0 : tmpstr = nl_in(mcur)
1866 :
1867 : ! mode name
1868 0 : ipos = index(tmpstr, ':')
1869 0 : if (ipos < 2) call parse_error('mode name not found', tmpstr)
1870 0 : modes%names(m) = tmpstr(:ipos-1)
1871 0 : tmpstr = tmpstr(ipos+1:)
1872 :
1873 : ! mode type
1874 0 : ipos = index(tmpstr, ':')
1875 0 : if (ipos == 0) call parse_error('mode type not found', tmpstr)
1876 : ! check for valid mode type
1877 0 : call check_mode_type(tmpstr, 1, ipos-1)
1878 0 : modes%types(m) = tmpstr(:ipos-1)
1879 0 : tmpstr = tmpstr(ipos+1:)
1880 :
1881 : ! mode type must be followed by '='
1882 0 : if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr)
1883 :
1884 : ! move to next string
1885 0 : mcur = mcur + 1
1886 0 : tmpstr = nl_in(mcur)
1887 :
1888 : ! process mode component strings
1889 : num_mr_found = .false. ! keep track of whether number mixing ratio component is found
1890 : ispec = 0 ! keep track of the number of species found
1891 : do
1892 :
1893 : ! source of interstitial component
1894 0 : ipos = index(tmpstr, ':')
1895 0 : if (ipos < 2) call parse_error('expect to find source field first', tmpstr)
1896 : ! check for valid source
1897 0 : if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
1898 0 : call parse_error('source must be A, N or Z', tmpstr)
1899 0 : tmp_src_a = tmpstr(:ipos-1)
1900 0 : tmpstr = tmpstr(ipos+1:)
1901 :
1902 : ! name of interstitial component
1903 0 : ipos = index(tmpstr, ':')
1904 0 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
1905 0 : tmp_name_a = tmpstr(:ipos-1)
1906 0 : tmpstr = tmpstr(ipos+1:)
1907 :
1908 : ! source of cloud borne component
1909 0 : ipos = index(tmpstr, ':')
1910 0 : if (ipos < 2) call parse_error('expect to find a source field', tmpstr)
1911 : ! check for valid source
1912 0 : if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
1913 0 : call parse_error('source must be A, N or Z', tmpstr)
1914 0 : tmp_src_c = tmpstr(:ipos-1)
1915 0 : tmpstr = tmpstr(ipos+1:)
1916 :
1917 : ! name of cloud borne component
1918 0 : ipos = index(tmpstr, ':')
1919 0 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
1920 0 : tmp_name_c = tmpstr(:ipos-1)
1921 0 : tmpstr = tmpstr(ipos+1:)
1922 :
1923 : ! component type
1924 0 : ipos = scan(tmpstr, ': ')
1925 0 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
1926 :
1927 0 : if (tmpstr(:ipos-1) == 'num_mr') then
1928 :
1929 : ! there can only be one number mixing ratio component
1930 0 : if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur))
1931 :
1932 0 : num_mr_found = .true.
1933 0 : modes%comps(m)%source_num_a = tmp_src_a
1934 0 : modes%comps(m)%camname_num_a = tmp_name_a
1935 0 : modes%comps(m)%source_num_c = tmp_src_c
1936 0 : modes%comps(m)%camname_num_c = tmp_name_c
1937 0 : tmpstr = tmpstr(ipos+1:)
1938 :
1939 : else
1940 :
1941 : ! check for valid specie type
1942 0 : call check_specie_type(tmpstr, 1, ipos-1)
1943 0 : tmp_type = tmpstr(:ipos-1)
1944 0 : tmpstr = tmpstr(ipos+1:)
1945 :
1946 : ! get the properties file
1947 0 : ipos = scan(tmpstr, ': ')
1948 0 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
1949 : ! check for valid filename -- must have .nc extension
1950 0 : if (tmpstr(ipos-3:ipos-1) /= '.nc') &
1951 0 : call parse_error('filename not valid', tmpstr)
1952 :
1953 0 : ispec = ispec + 1
1954 0 : modes%comps(m)%source_mmr_a(ispec) = tmp_src_a
1955 0 : modes%comps(m)%camname_mmr_a(ispec) = tmp_name_a
1956 0 : modes%comps(m)%source_mmr_c(ispec) = tmp_src_c
1957 0 : modes%comps(m)%camname_mmr_c(ispec) = tmp_name_c
1958 0 : modes%comps(m)%type(ispec) = tmp_type
1959 0 : modes%comps(m)%props(ispec) = tmpstr(:ipos-1)
1960 0 : tmpstr = tmpstr(ipos+1:)
1961 : end if
1962 :
1963 : ! check if there are more components. either the current character is
1964 : ! a ' ' which means this string is the final mode component, or the character
1965 : ! is a '+' which means there are more components
1966 0 : if (tmpstr(1:1) == ' ') exit
1967 :
1968 0 : if (tmpstr(1:1) /= '+') &
1969 0 : call parse_error('+ field not found', tmpstr)
1970 :
1971 : ! continue to next component...
1972 0 : mcur = mcur + 1
1973 0 : tmpstr = nl_in(mcur)
1974 : end do
1975 :
1976 : ! check that a number component was found
1977 0 : if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg))
1978 :
1979 : ! check that the right number of species were found
1980 0 : if (ispec /= nspec) call parse_error('component parsing got wrong number of species', nl_in(mbeg))
1981 :
1982 : ! continue to next mode...
1983 0 : mcur = mcur + 1
1984 0 : tmpstr = nl_in(mcur)
1985 : end do
1986 :
1987 : !------------------------------------------------------------------------------------------------
1988 : contains
1989 : !------------------------------------------------------------------------------------------------
1990 :
1991 : ! internal subroutines used for error checking and reporting
1992 :
1993 0 : subroutine parse_error(msg, str)
1994 :
1995 : character(len=*), intent(in) :: msg
1996 : character(len=*), intent(in) :: str
1997 :
1998 0 : write(iulog,*) routine//': ERROR: '//msg
1999 0 : write(iulog,*) ' input string: '//trim(str)
2000 0 : call endrun(routine//': ERROR: '//msg)
2001 :
2002 0 : end subroutine parse_error
2003 :
2004 : !------------------------------------------------------------------------------------------------
2005 :
2006 0 : subroutine check_specie_type(str, ib, ie)
2007 :
2008 : character(len=*), intent(in) :: str
2009 : integer, intent(in) :: ib, ie
2010 :
2011 : integer :: i
2012 :
2013 0 : do i = 1, num_spec_types
2014 0 : if (str(ib:ie) == trim(spec_type_names(i))) return
2015 : end do
2016 :
2017 0 : call parse_error('specie type not valid', str(ib:ie))
2018 :
2019 : end subroutine check_specie_type
2020 :
2021 : !------------------------------------------------------------------------------------------------
2022 :
2023 0 : subroutine check_mode_type(str, ib, ie)
2024 :
2025 : character(len=*), intent(in) :: str
2026 : integer, intent(in) :: ib, ie ! begin, end character of mode type substring
2027 :
2028 : integer :: i
2029 :
2030 0 : do i = 1, num_mode_types
2031 0 : if (str(ib:ie) == trim(mode_type_names(i))) return
2032 : end do
2033 :
2034 0 : call parse_error('mode type not valid', str(ib:ie))
2035 :
2036 : end subroutine check_mode_type
2037 :
2038 : !------------------------------------------------------------------------------------------------
2039 :
2040 : end subroutine parse_mode_defs
2041 :
2042 : !================================================================================================
2043 :
2044 1536 : subroutine parse_bin_defs(nl_in, bins)
2045 :
2046 : ! Parse the bin definition specifiers. The specifiers are of the form:
2047 : !
2048 : ! 'bin_name:=',
2049 : ! 'source_num_a:camname_num_a:source_num_c:camname_num_c:num_mr:+',
2050 : ! 'source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file[:+]'[,]
2051 : ! ['source_mmr_a:camname_mmr_a:source_mmr_c:camname_mmr_c:spec_type:prop_file][:+][']
2052 : !
2053 : ! where the ':' separated fields are:
2054 : ! bin_name -- name of the bin.
2055 : ! = -- this line terminator identifies the initial string in a
2056 : ! mode definition
2057 : ! + -- this line terminator indicates that the mode definition is
2058 : ! continued in the next string
2059 : ! source_num_a -- Source of interstitial number mixing ratio, 'A', 'N', or 'Z'
2060 : ! camname_num_a -- the name of the interstitial number component. This name must be
2061 : ! registered in the constituent arrays when source=A or in the
2062 : ! physics buffer when source=N
2063 : ! source_num_c -- Source of cloud borne number mixing ratio, 'A', 'N', or 'Z'
2064 : ! camname_num_c -- the name of the cloud borne number component. This name must be
2065 : ! registered in the constituent arrays when source=A or in the
2066 : ! physics buffer when source=N
2067 : ! source_mmr_a -- Source of interstitial specie mass mixing ratio, 'A', 'N' or 'Z'
2068 : ! camname_mmr_a -- the name of the interstitial specie. This name must be
2069 : ! registered in the constituent arrays when source=A or in the
2070 : ! physics buffer when source=N
2071 : ! source_mmr_c -- Source of cloud borne specie mass mixing ratio, 'A', 'N' or 'Z'
2072 : ! camname_mmr_c -- the name of the cloud borne specie. This name must be
2073 : ! registered in the constituent arrays when source=A or in the
2074 : ! physics buffer when source=N
2075 : ! spec_type -- species type. Valid values are particle, shell, and core.
2076 : ! prop_file -- For aerosol species this is a filename, which is
2077 : ! identified by a ".nc" suffix. The file contains optical and
2078 : ! other physical properties of the aerosol.
2079 : !
2080 : ! A bin definition must contain at least 1 string for the species and can contain
2081 : ! a maximum of 1 particle type.
2082 :
2083 :
2084 : character(len=*), intent(inout) :: nl_in(:) ! namelist input (blanks are removed on output)
2085 : type(bins_t), intent(inout) :: bins ! structure containing parsed input
2086 :
2087 : ! Local variables
2088 : logical :: num_mr_found, mass_mr_found
2089 : logical :: particle_mr_found
2090 : integer :: m
2091 : integer :: istat
2092 : integer :: nbins, nstr, istr
2093 : integer :: mbeg, mcur
2094 : integer :: nspec, ispec
2095 : integer :: strlen, ibeg, iend, ipos
2096 : logical :: part_mr_found
2097 : character(len=*), parameter :: routine = 'parse_bin_defs'
2098 1536 : character(len=len(nl_in(1))) :: tmpstr
2099 : character(len=1) :: tmp_src_a
2100 : character(len=32) :: tmp_name_a
2101 : character(len=1) :: tmp_src_c
2102 : character(len=32) :: tmp_name_c
2103 : character(len=32) :: tmp_type
2104 : character(len=32) :: tmp_morph
2105 : !-------------------------------------------------------------------------
2106 :
2107 : ! Determine number of bins defined by counting number of strings that are
2108 : ! terminated by ':='
2109 : ! (algorithm stops counting at first blank element).
2110 1536 : nbins = 0
2111 1536 : nstr = 0
2112 339456 : do m = 1, n_bin_str
2113 :
2114 339456 : if (len_trim(nl_in(m)) == 0) exit
2115 337920 : nstr = nstr + 1
2116 :
2117 : ! There are no fields in the input strings in which a blank character is allowed.
2118 : ! To simplify the parsing go through the input strings and remove blanks.
2119 337920 : tmpstr = adjustl(nl_in(m))
2120 337920 : nl_in(m) = tmpstr
2121 : do
2122 337920 : strlen = len_trim(nl_in(m))
2123 337920 : ipos = index(nl_in(m), ' ')
2124 337920 : if (ipos == 0 .or. ipos > strlen) exit
2125 0 : tmpstr = nl_in(m)(:ipos-1) // nl_in(m)(ipos+1:strlen)
2126 337920 : nl_in(m) = tmpstr
2127 : end do
2128 : ! count strings with ':=' terminator
2129 339456 : if (nl_in(m)(strlen-1:strlen) == ':=') nbins = nbins + 1
2130 :
2131 : end do
2132 1536 : bins%nbins = nbins
2133 :
2134 : ! return if no bins defined
2135 1536 : if (nbins == 0) return
2136 :
2137 : ! allocate components that depend on nmodes
2138 : allocate( &
2139 : bins%names(nbins), &
2140 : bins%comps(nbins), &
2141 7680 : stat=istat )
2142 1536 : if (istat > 0) then
2143 0 : write(iulog,*) routine//': ERROR: cannot allocate storage for bins. nbins=', nbins
2144 0 : call endrun(routine//': ERROR allocating storage for bins')
2145 : end if
2146 :
2147 1536 : mcur = 1 ! index of current string being processed
2148 :
2149 : ! loop over bins
2150 62976 : bins_loop: do m = 1, nbins
2151 :
2152 61440 : mbeg = mcur ! remember the first string of a bin
2153 :
2154 : ! check that first string in bin definition is ':=' terminated
2155 61440 : iend = len_trim(nl_in(mcur))
2156 61440 : if (nl_in(mcur)(iend-1:iend) /= ':=') call parse_error('= not found', nl_in(mcur))
2157 :
2158 : ! count species in bin definition. definition will contain 1 string with
2159 : ! with a ':+' terminator for each specie
2160 61440 : nspec = 0
2161 61440 : mcur = mcur + 1
2162 215040 : do
2163 276480 : iend = len_trim(nl_in(mcur))
2164 276480 : if (nl_in(mcur)(iend-1:iend) /= ':+') exit
2165 215040 : if (nl_in(mcur)(iend-4:iend) /= 'mmr:+') nspec = nspec + 1
2166 215040 : mcur = mcur + 1
2167 : end do
2168 :
2169 : ! a bin must have at least one specie
2170 61440 : if (nspec == 0) call parse_error('bin must have at least one specie', nl_in(mbeg))
2171 :
2172 : ! allocate components that depend on number of species
2173 : allocate( &
2174 0 : bins%comps(m)%source_mmr_a(nspec), &
2175 0 : bins%comps(m)%camname_mmr_a(nspec), &
2176 0 : bins%comps(m)%source_mmr_c(nspec), &
2177 0 : bins%comps(m)%camname_mmr_c(nspec), &
2178 0 : bins%comps(m)%type(nspec), &
2179 0 : bins%comps(m)%morph(nspec), &
2180 0 : bins%comps(m)%props(nspec), &
2181 614400 : stat=istat)
2182 :
2183 61440 : if (istat > 0) then
2184 0 : write(iulog,*) routine//': ERROR: cannot allocate storage for species. nspec=', nspec
2185 0 : call endrun(routine//': ERROR allocating storage for species')
2186 : end if
2187 :
2188 : ! initialize components
2189 61440 : bins%comps(m)%nspec = nspec
2190 61440 : bins%comps(m)%source_num_a = ' '
2191 61440 : bins%comps(m)%camname_num_a = ' '
2192 61440 : bins%comps(m)%source_num_c = ' '
2193 61440 : bins%comps(m)%camname_num_c = ' '
2194 61440 : bins%comps(m)%source_mass_a = 'NOTSET'
2195 61440 : bins%comps(m)%camname_mass_a = 'NOTSET'
2196 61440 : bins%comps(m)%source_mass_c = 'NOTSET'
2197 61440 : bins%comps(m)%camname_mass_c = 'NOTSET'
2198 276480 : do ispec = 1, nspec
2199 215040 : bins%comps(m)%source_mmr_a(ispec) = ' '
2200 215040 : bins%comps(m)%camname_mmr_a(ispec) = ' '
2201 215040 : bins%comps(m)%source_mmr_c(ispec) = ' '
2202 215040 : bins%comps(m)%camname_mmr_c(ispec) = ' '
2203 215040 : bins%comps(m)%type(ispec) = ' '
2204 276480 : bins%comps(m)%props(ispec) = ' '
2205 : end do
2206 :
2207 : ! return to first string in mode definition
2208 61440 : mcur = mbeg
2209 61440 : tmpstr = nl_in(mcur)
2210 :
2211 : ! bin name
2212 61440 : ipos = index(tmpstr, ':')
2213 61440 : if (ipos < 2) call parse_error('bin name not found', tmpstr)
2214 61440 : bins%names(m) = tmpstr(:ipos-1)
2215 61440 : tmpstr = tmpstr(ipos+1:)
2216 :
2217 : ! bin name must be followed by '='
2218 61440 : if (tmpstr(1:1) /= '=') call parse_error('= not found', tmpstr)
2219 :
2220 : ! move to next string
2221 61440 : mcur = mcur + 1
2222 61440 : tmpstr = nl_in(mcur)
2223 :
2224 : ! process bin component strings
2225 61440 : particle_mr_found = .false. ! keep track of whether particle mixing ratio component is found
2226 61440 : num_mr_found = .false. ! keep track of whether number mixing ratio component is found
2227 61440 : mass_mr_found = .false. ! keep track of whether number mixing ratio component is found
2228 61440 : ispec = 0 ! keep track of the number of species found
2229 : comps_loop: do
2230 :
2231 : ! source of interstitial component
2232 276480 : ipos = index(tmpstr, ':')
2233 276480 : if (ipos < 2) call parse_error('expect to find source field first', tmpstr)
2234 : ! check for valid source
2235 276480 : if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
2236 0 : call parse_error('source must be A, N or Z', tmpstr)
2237 276480 : tmp_src_a = tmpstr(:ipos-1)
2238 276480 : tmpstr = tmpstr(ipos+1:)
2239 :
2240 : ! name of interstitial component
2241 276480 : ipos = index(tmpstr, ':')
2242 276480 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
2243 276480 : tmp_name_a = tmpstr(:ipos-1)
2244 276480 : tmpstr = tmpstr(ipos+1:)
2245 :
2246 : ! source of cloud borne component
2247 276480 : ipos = index(tmpstr, ':')
2248 276480 : if (ipos < 2) call parse_error('expect to find a source field', tmpstr)
2249 : ! check for valid source
2250 276480 : if (tmpstr(:ipos-1) /= 'A' .and. tmpstr(:ipos-1) /= 'N' .and. tmpstr(:ipos-1) /= 'Z') &
2251 0 : call parse_error('source must be A, N or Z', tmpstr)
2252 276480 : tmp_src_c = tmpstr(:ipos-1)
2253 276480 : tmpstr = tmpstr(ipos+1:)
2254 :
2255 : ! name of cloud borne component
2256 276480 : ipos = index(tmpstr, ':')
2257 276480 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
2258 276480 : tmp_name_c = tmpstr(:ipos-1)
2259 276480 : tmpstr = tmpstr(ipos+1:)
2260 :
2261 : ! component type
2262 276480 : ipos = scan(tmpstr, ': ')
2263 276480 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
2264 :
2265 276480 : if (tmpstr(:ipos-1) == 'num') then
2266 :
2267 : ! there can only be one number mixing ratio component
2268 61440 : if (num_mr_found) call parse_error('more than 1 number component', nl_in(mcur))
2269 :
2270 61440 : num_mr_found = .true.
2271 61440 : bins%comps(m)%source_num_a = tmp_src_a
2272 61440 : bins%comps(m)%camname_num_a = tmp_name_a
2273 61440 : bins%comps(m)%source_num_c = tmp_src_c
2274 61440 : bins%comps(m)%camname_num_c = tmp_name_c
2275 61440 : tmpstr = tmpstr(ipos+1:)
2276 :
2277 215040 : else if (tmpstr(:ipos-1) == 'mmr') then
2278 :
2279 : ! there can only be one number mixing ratio component
2280 0 : if (mass_mr_found) call parse_error('more than 1 mass mixing ratio component', nl_in(mcur))
2281 :
2282 0 : mass_mr_found = .true.
2283 0 : bins%comps(m)%source_mass_a = tmp_src_a
2284 0 : bins%comps(m)%camname_mass_a = tmp_name_a
2285 0 : bins%comps(m)%source_mass_c = tmp_src_c
2286 0 : bins%comps(m)%camname_mass_c = tmp_name_c
2287 0 : tmpstr = tmpstr(ipos+1:)
2288 :
2289 : else
2290 :
2291 : ! check for valid species type
2292 215040 : call check_bin_type(tmpstr, 1, ipos-1)
2293 215040 : tmp_type = tmpstr(:ipos-1)
2294 215040 : tmpstr = tmpstr(ipos+1:)
2295 :
2296 215040 : ipos = index(tmpstr, ':')
2297 215040 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
2298 :
2299 : ! check for valid species type
2300 215040 : call check_bin_morph(tmpstr, 1, ipos-1)
2301 215040 : tmp_morph = tmpstr(:ipos-1)
2302 215040 : tmpstr = tmpstr(ipos+1:)
2303 :
2304 : ! get the properties file
2305 215040 : ipos = scan(tmpstr, ': ')
2306 215040 : if (ipos == 0) call parse_error('next separator not found', tmpstr)
2307 :
2308 : ! check for valid filename -- must have .nc extension
2309 215040 : if (tmpstr(ipos-3:ipos-1) /= '.nc') &
2310 0 : call parse_error('filename not valid', tmpstr)
2311 :
2312 215040 : ispec = ispec + 1
2313 :
2314 215040 : bins%comps(m)%source_mmr_a(ispec) = tmp_src_a
2315 215040 : bins%comps(m)%camname_mmr_a(ispec) = tmp_name_a
2316 215040 : bins%comps(m)%source_mmr_c(ispec) = tmp_src_c
2317 215040 : bins%comps(m)%camname_mmr_c(ispec) = tmp_name_c
2318 215040 : bins%comps(m)%type(ispec) = tmp_type
2319 215040 : bins%comps(m)%morph(ispec) = tmp_morph
2320 :
2321 215040 : bins%comps(m)%props(ispec) = tmpstr(:ipos-1)
2322 215040 : tmpstr = tmpstr(ipos+1:)
2323 :
2324 : endif
2325 :
2326 : ! check if there are more components. either the current character is
2327 : ! a ' ' which means this string is the final mode component, or the character
2328 : ! is a '+' which means there are more components
2329 276480 : if (tmpstr(1:1) == ' ') then
2330 : exit comps_loop
2331 : endif
2332 :
2333 215040 : if (tmpstr(1:1) /= '+') &
2334 0 : call parse_error('+ field not found', tmpstr)
2335 :
2336 : ! continue to next component...
2337 215040 : mcur = mcur + 1
2338 276480 : tmpstr = nl_in(mcur)
2339 : end do comps_loop
2340 :
2341 :
2342 : ! check that a number component was found
2343 61440 : if (.not. num_mr_found) call parse_error('number component not found', nl_in(mbeg))
2344 :
2345 : ! check that the right number of species were found
2346 61440 : if (ispec /= nspec) then
2347 0 : write(*,*) 'ispec, nspec = ',ispec, nspec
2348 : call parse_error('component parsing got wrong number of species', nl_in(mbeg))
2349 : endif
2350 :
2351 : ! continue to next bin...
2352 61440 : mcur = mcur + 1
2353 62976 : tmpstr = nl_in(mcur)
2354 : end do bins_loop
2355 :
2356 : !------------------------------------------------------------------------------------------------
2357 : contains
2358 : !------------------------------------------------------------------------------------------------
2359 :
2360 : ! internal subroutines used for error checking and reporting
2361 :
2362 0 : subroutine parse_error(msg, str)
2363 :
2364 : character(len=*), intent(in) :: msg
2365 : character(len=*), intent(in) :: str
2366 :
2367 0 : write(iulog,*) routine//': ERROR: '//msg
2368 0 : write(iulog,*) ' input string: '//trim(str)
2369 0 : call endrun(routine//': ERROR: '//msg)
2370 :
2371 0 : end subroutine parse_error
2372 :
2373 : !------------------------------------------------------------------------------------------------
2374 :
2375 215040 : subroutine check_bin_morph(str, ib, ie)
2376 :
2377 : character(len=*), intent(in) :: str
2378 : integer, intent(in) :: ib, ie
2379 :
2380 : integer :: i
2381 :
2382 276480 : do i = 1, num_bin_morphs
2383 276480 : if (str(ib:ie) == trim(bin_morph_names(i))) return
2384 : end do
2385 :
2386 0 : call parse_error('bin morph not valid', str(ib:ie))
2387 :
2388 : end subroutine check_bin_morph
2389 :
2390 : !------------------------------------------------------------------------------------------------
2391 215040 : subroutine check_bin_type(str, ib, ie)
2392 :
2393 : character(len=*), intent(in) :: str
2394 : integer, intent(in) :: ib, ie ! begin, end character of mode type substring
2395 :
2396 : integer :: i
2397 :
2398 983040 : do i = 1, num_spec_types
2399 983040 : if (str(ib:ie) == trim(spec_type_names(i))) return
2400 : end do
2401 :
2402 0 : call parse_error('bin species type not valid', str(ib:ie))
2403 :
2404 : end subroutine check_bin_type
2405 :
2406 : !------------------------------------------------------------------------------------------------
2407 :
2408 : end subroutine parse_bin_defs
2409 :
2410 : !================================================================================================
2411 :
2412 16896 : subroutine parse_rad_specifier(specifier, namelist_data)
2413 :
2414 : !-----------------------------------------------------------------------------
2415 : ! Private method for parsing the radiation namelist specifiers. The specifiers
2416 : ! are of the form 'source_camname:radname' where:
2417 : ! source -- either 'N' for pbuf (non-advected) or 'A' for state (advected)
2418 : ! camname -- the name of a constituent that must be found in the constituent
2419 : ! component of the state when source=A or in the physics buffer
2420 : ! when source=N
2421 : ! radname -- For gases this is a name that identifies the constituent to the
2422 : ! radiative transfer codes. These names are contained in the
2423 : ! radconstants module. For aerosols this is a filename, which is
2424 : ! identified by a ".nc" suffix. The file contains optical and
2425 : ! other physical properties of the aerosol.
2426 : !
2427 : ! This code also identifies whether the constituent is a gas or an aerosol
2428 : ! and adds that info to a structure that stores the parsed data.
2429 : !-----------------------------------------------------------------------------
2430 :
2431 : character(len=*), dimension(:), intent(in) :: specifier
2432 : type(rad_cnst_namelist_t), intent(inout) :: namelist_data
2433 :
2434 : ! Local variables
2435 : integer :: number, i, j
2436 : integer :: ipos, strlen
2437 : integer :: astat
2438 : character(len=cs1) :: tmpstr
2439 : character(len=1) :: source(n_rad_cnst)
2440 : character(len=64) :: camname(n_rad_cnst)
2441 : character(len=cs1) :: radname(n_rad_cnst)
2442 : character(len=1) :: type(n_rad_cnst)
2443 : !-------------------------------------------------------------------------
2444 :
2445 16896 : number = 0
2446 :
2447 90624 : parse_loop: do i = 1, n_rad_cnst
2448 90624 : if ( len_trim(specifier(i)) == 0 ) then
2449 : exit parse_loop
2450 : endif
2451 :
2452 : ! There are no fields in the input strings in which a blank character is allowed.
2453 : ! To simplify the parsing go through the input strings and remove blanks.
2454 73728 : tmpstr = adjustl(specifier(i))
2455 0 : do
2456 73728 : strlen = len_trim(tmpstr)
2457 73728 : ipos = index(tmpstr, ' ')
2458 73728 : if (ipos == 0 .or. ipos > strlen) exit
2459 73728 : tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen)
2460 : end do
2461 :
2462 : ! Locate the ':' separating source from camname.
2463 73728 : j = index(tmpstr, ':')
2464 73728 : source(i) = tmpstr(:j-1)
2465 73728 : tmpstr = tmpstr(j+1:)
2466 :
2467 : ! locate the ':' separating camname from radname
2468 73728 : j = scan(tmpstr, ':')
2469 :
2470 73728 : camname(i) = tmpstr(:j-1)
2471 73728 : radname(i) = tmpstr(j+1:)
2472 :
2473 : ! determine the type of constituent
2474 73728 : if (source(i) == 'M') then
2475 0 : type(i) = 'M'
2476 73728 : else if (source(i) == 'B') then
2477 61440 : type(i) = 'B'
2478 12288 : else if(index(radname(i),".nc") .gt. 0) then
2479 0 : type(i) = 'A'
2480 : else
2481 12288 : type(i) = 'G'
2482 : end if
2483 :
2484 90624 : number = number+1
2485 : end do parse_loop
2486 :
2487 16896 : namelist_data%ncnst = number
2488 :
2489 16896 : if (number == 0) return
2490 :
2491 3072 : allocate(namelist_data%source (number), stat=astat)
2492 1536 : if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%source')
2493 4608 : allocate(namelist_data%camname(number), stat=astat)
2494 0 : if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%camname')
2495 4608 : allocate(namelist_data%radname(number), stat=astat)
2496 0 : if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%radname')
2497 3072 : allocate(namelist_data%type(number), stat=astat)
2498 0 : if( astat/= 0 ) call endrun('parse_rad_specifier: not able to allocate namelist_data%type')
2499 :
2500 75264 : namelist_data%source(:namelist_data%ncnst) = source (:namelist_data%ncnst)
2501 75264 : namelist_data%camname(:namelist_data%ncnst) = camname(:namelist_data%ncnst)
2502 75264 : namelist_data%radname(:namelist_data%ncnst) = radname(:namelist_data%ncnst)
2503 75264 : namelist_data%type(:namelist_data%ncnst) = type(:namelist_data%ncnst)
2504 :
2505 : end subroutine parse_rad_specifier
2506 :
2507 : !================================================================================================
2508 :
2509 0 : subroutine rad_cnst_get_aer_mmr_by_idx(list_idx, aer_idx, state, pbuf, mmr)
2510 :
2511 : ! Return pointer to mass mixing ratio for the aerosol from the specified
2512 : ! climate or diagnostic list.
2513 :
2514 : ! Arguments
2515 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2516 : integer, intent(in) :: aer_idx
2517 : type(physics_state), target, intent(in) :: state
2518 : type(physics_buffer_desc), pointer :: pbuf(:)
2519 : real(r8), pointer :: mmr(:,:)
2520 :
2521 : ! Local variables
2522 : integer :: lchnk
2523 : integer :: idx
2524 : character(len=1) :: source
2525 : type(aerlist_t), pointer :: aerlist
2526 : character(len=*), parameter :: subname = 'rad_cnst_get_aer_mmr_by_idx'
2527 : !-----------------------------------------------------------------------------
2528 :
2529 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2530 0 : aerlist => aerosollist(list_idx)
2531 : else
2532 0 : write(iulog,*) subname//': list_idx =', list_idx
2533 0 : call endrun(subname//': list_idx out of bounds')
2534 : endif
2535 :
2536 0 : lchnk = state%lchnk
2537 :
2538 : ! Check for valid input aerosol index
2539 0 : if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then
2540 0 : write(iulog,*) subname//': aer_idx= ', aer_idx, ' numaerosols= ', aerlist%numaerosols
2541 0 : call endrun(subname//': aerosol list index out of range')
2542 : end if
2543 :
2544 : ! Get data source
2545 0 : source = aerlist%aer(aer_idx)%source
2546 0 : idx = aerlist%aer(aer_idx)%idx
2547 0 : select case( source )
2548 : case ('A')
2549 0 : mmr => state%q(:,:,idx)
2550 : case ('N')
2551 0 : call pbuf_get_field(pbuf, idx, mmr)
2552 : case ('Z')
2553 0 : mmr => zero_cols
2554 : end select
2555 :
2556 0 : end subroutine rad_cnst_get_aer_mmr_by_idx
2557 :
2558 : !================================================================================================
2559 :
2560 0 : subroutine rad_cnst_get_mam_mmr_by_idx(list_idx, mode_idx, spec_idx, phase, state, pbuf, mmr)
2561 :
2562 : ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified
2563 : ! climate or diagnostic list.
2564 :
2565 : ! Arguments
2566 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2567 : integer, intent(in) :: mode_idx ! mode index
2568 : integer, intent(in) :: spec_idx ! index of specie in the mode
2569 : character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne
2570 : type(physics_state), target, intent(in) :: state
2571 : type(physics_buffer_desc), pointer :: pbuf(:)
2572 : real(r8), pointer :: mmr(:,:)
2573 :
2574 : ! Local variables
2575 : integer :: m_idx
2576 : integer :: idx
2577 : integer :: lchnk
2578 : character(len=1) :: source
2579 : type(modelist_t), pointer :: mlist
2580 : character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_by_idx'
2581 : !-----------------------------------------------------------------------------
2582 :
2583 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2584 0 : mlist => ma_list(list_idx)
2585 : else
2586 0 : write(iulog,*) subname//': list_idx =', list_idx
2587 0 : call endrun(subname//': list_idx out of bounds')
2588 : endif
2589 :
2590 : ! Check for valid mode index
2591 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
2592 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
2593 0 : call endrun(subname//': mode list index out of range')
2594 : end if
2595 :
2596 : ! Get the index for the corresponding mode in the mode definition object
2597 0 : m_idx = mlist%idx(mode_idx)
2598 :
2599 : ! Check for valid specie index
2600 0 : if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then
2601 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec
2602 0 : call endrun(subname//': specie list index out of range')
2603 : end if
2604 :
2605 : ! Get data source
2606 0 : if (phase == 'a') then
2607 0 : source = modes%comps(m_idx)%source_mmr_a(spec_idx)
2608 0 : idx = modes%comps(m_idx)%idx_mmr_a(spec_idx)
2609 0 : else if (phase == 'c') then
2610 0 : source = modes%comps(m_idx)%source_mmr_c(spec_idx)
2611 0 : idx = modes%comps(m_idx)%idx_mmr_c(spec_idx)
2612 : else
2613 0 : write(iulog,*) subname//': phase= ', phase
2614 0 : call endrun(subname//': unrecognized phase; must be "a" or "c"')
2615 : end if
2616 :
2617 0 : lchnk = state%lchnk
2618 :
2619 0 : select case( source )
2620 : case ('A')
2621 0 : mmr => state%q(:,:,idx)
2622 : case ('N')
2623 0 : call pbuf_get_field(pbuf, idx, mmr)
2624 : case ('Z')
2625 0 : mmr => zero_cols
2626 : end select
2627 :
2628 0 : end subroutine rad_cnst_get_mam_mmr_by_idx
2629 :
2630 : !================================================================================================
2631 :
2632 33914344452 : subroutine rad_cnst_get_bin_mmr_by_idx(list_idx, bin_idx, spec_idx, phase, state, pbuf, mmr)
2633 :
2634 : ! Return pointer to mass mixing ratio for the modal aerosol specie from the specified
2635 : ! climate or diagnostic list.
2636 :
2637 : ! Arguments
2638 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2639 : integer, intent(in) :: bin_idx ! mode index
2640 : integer, intent(in) :: spec_idx ! index of specie in the mode
2641 : character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne
2642 : type(physics_state), target, intent(in) :: state
2643 : type(physics_buffer_desc), pointer :: pbuf(:)
2644 : real(r8), pointer :: mmr(:,:)
2645 :
2646 : ! Local variables
2647 : integer :: s_idx
2648 : integer :: idx
2649 : integer :: lchnk
2650 : character(len=1) :: source
2651 : type(binlist_t), pointer :: slist
2652 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr_by_idx'
2653 : !-----------------------------------------------------------------------------
2654 :
2655 33914344452 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2656 33914344452 : slist => sa_list(list_idx)
2657 : else
2658 0 : write(iulog,*) subname//': list_idx =', list_idx
2659 0 : call endrun(subname//': list_idx out of bounds')
2660 : endif
2661 :
2662 : ! Check for valid mode index
2663 33914344452 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
2664 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
2665 0 : call endrun(subname//': bin list index out of range')
2666 : end if
2667 :
2668 : ! Get the index for the corresponding mode in the mode definition object
2669 33914344452 : s_idx = slist%idx(bin_idx)
2670 :
2671 : ! Check for valid specie index
2672 33914344452 : if (spec_idx < 1 .or. spec_idx > bins%comps(s_idx)%nspec) then
2673 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(s_idx)%nspec
2674 0 : call endrun(subname//': specie list index out of range')
2675 : end if
2676 :
2677 : ! Get data source
2678 33914344452 : if (phase == 'a') then
2679 25033805826 : source = bins%comps(s_idx)%source_mmr_a(spec_idx)
2680 25033805826 : idx = bins%comps(s_idx)%idx_mmr_a(spec_idx)
2681 8880538626 : else if (phase == 'c') then
2682 8880538626 : source = bins%comps(s_idx)%source_mmr_c(spec_idx)
2683 8880538626 : idx = bins%comps(s_idx)%idx_mmr_c(spec_idx)
2684 : else
2685 0 : write(iulog,*) subname//': phase= ', phase
2686 0 : call endrun(subname//': unrecognized phase; must be "a" or "c"')
2687 : end if
2688 :
2689 33914344452 : lchnk = state%lchnk
2690 :
2691 25033805826 : select case( source )
2692 : case ('A')
2693 25033805826 : mmr => state%q(:,:,idx)
2694 : case ('N')
2695 8880538626 : call pbuf_get_field(pbuf, idx, mmr)
2696 : case ('Z')
2697 33914344452 : mmr => zero_cols
2698 : end select
2699 :
2700 33914344452 : end subroutine rad_cnst_get_bin_mmr_by_idx
2701 :
2702 : !================================================================================================
2703 :
2704 0 : subroutine rad_cnst_get_mam_mmr_idx(mode_idx, spec_idx, idx)
2705 :
2706 : ! Return constituent index of mam specie mass mixing ratio for aerosol modes in
2707 : ! the climate list.
2708 :
2709 : ! This is a special routine to allow direct access to information in the
2710 : ! constituent array inside physics parameterizations that have been passed,
2711 : ! and are operating over the entire constituent array. The interstitial phase
2712 : ! is assumed since that's what is contained in the constituent array.
2713 :
2714 : ! Arguments
2715 : integer, intent(in) :: mode_idx ! mode index
2716 : integer, intent(in) :: spec_idx ! index of specie in the mode
2717 : integer, intent(out) :: idx ! index of specie in the constituent array
2718 :
2719 : ! Local variables
2720 : integer :: m_idx
2721 : type(modelist_t), pointer :: mlist
2722 : character(len=*), parameter :: subname = 'rad_cnst_get_mam_mmr_idx'
2723 : !-----------------------------------------------------------------------------
2724 :
2725 : ! assume climate list (i.e., species are in the constituent array)
2726 0 : mlist => ma_list(0)
2727 :
2728 : ! Check for valid mode index
2729 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
2730 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
2731 0 : call endrun(subname//': mode list index out of range')
2732 : end if
2733 :
2734 : ! Get the index for the corresponding mode in the mode definition object
2735 0 : m_idx = mlist%idx(mode_idx)
2736 :
2737 : ! Check for valid specie index
2738 0 : if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then
2739 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec
2740 0 : call endrun(subname//': specie list index out of range')
2741 : end if
2742 :
2743 : ! Assume data source is interstitial since that's what's in the constituent array
2744 0 : idx = modes%comps(m_idx)%idx_mmr_a(spec_idx)
2745 :
2746 0 : end subroutine rad_cnst_get_mam_mmr_idx
2747 :
2748 : !================================================================================================
2749 :
2750 0 : subroutine rad_cnst_get_carma_mmr_idx(bin_idx, spec_idx, idx)
2751 :
2752 : ! Return constituent index of camra species mass mixing ratio for aerosol bins in
2753 : ! the climate list.
2754 :
2755 : ! This is a special routine to allow direct access to information in the
2756 : ! constituent array inside physics parameterizations that have been passed,
2757 : ! and are operating over the entire constituent array. The interstitial phase
2758 : ! is assumed since that's what is contained in the constituent array.
2759 :
2760 : ! Arguments
2761 : integer, intent(in) :: bin_idx ! bin index
2762 : integer, intent(in) :: spec_idx ! index of specie in the bin
2763 : integer, intent(out) :: idx ! index of specie in the constituent array
2764 :
2765 : ! Local variables
2766 : integer :: b_idx
2767 : type(binlist_t), pointer :: slist
2768 : character(len=*), parameter :: subname = 'rad_cnst_get_carma_mmr_idx'
2769 : !-----------------------------------------------------------------------------
2770 :
2771 : ! assume climate list (i.e., species are in the constituent array)
2772 0 : slist => sa_list(0)
2773 :
2774 : ! Check for valid bin index
2775 0 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
2776 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
2777 0 : call endrun(subname//': bin list index out of range')
2778 : end if
2779 :
2780 : ! Get the index for the corresponding bin in the bin definition object
2781 0 : b_idx = slist%idx(bin_idx)
2782 :
2783 : ! Check for valid specie index
2784 0 : if (spec_idx < 1 .or. spec_idx > bins%comps(b_idx)%nspec) then
2785 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(b_idx)%nspec
2786 0 : call endrun(subname//': specie list index out of range')
2787 : end if
2788 :
2789 : ! Assume data source is interstitial since that's what's in the constituent array
2790 0 : idx = bins%comps(b_idx)%idx_mmr_a(spec_idx)
2791 :
2792 0 : end subroutine rad_cnst_get_carma_mmr_idx
2793 :
2794 : !================================================================================================
2795 :
2796 0 : subroutine rad_cnst_get_bin_mmr(list_idx, bin_idx, phase, state, pbuf, mmr)
2797 :
2798 : ! Return pointer to mass mixing ratio for the aerosol bin from the specified
2799 : ! climate or diagnostic list.
2800 :
2801 : ! Arguments
2802 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2803 : integer, intent(in) :: bin_idx ! bin index
2804 : character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne
2805 : type(physics_state), target, intent(in) :: state
2806 : type(physics_buffer_desc), pointer :: pbuf(:)
2807 : real(r8), pointer :: mmr(:,:)
2808 :
2809 : ! Local variables
2810 : integer :: m_idx
2811 : integer :: idx
2812 : integer :: lchnk
2813 : character(len=1) :: source
2814 : type(binlist_t), pointer :: slist
2815 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_mmr'
2816 : !-----------------------------------------------------------------------------
2817 :
2818 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2819 0 : slist => sa_list(list_idx)
2820 : else
2821 0 : write(iulog,*) subname//': list_idx =', list_idx
2822 0 : call endrun(subname//': list_idx out of bounds')
2823 : endif
2824 :
2825 : ! Check for valid bin index
2826 0 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
2827 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
2828 0 : call endrun(subname//': bin list index out of range')
2829 : end if
2830 :
2831 : ! Get the index for the corresponding bin in the bin definition object
2832 0 : m_idx = slist%idx(bin_idx)
2833 :
2834 : ! Get data source
2835 0 : if (phase == 'a') then
2836 0 : source = bins%comps(m_idx)%source_mass_a
2837 0 : idx = bins%comps(m_idx)%idx_mass_a
2838 0 : else if (phase == 'c') then
2839 0 : source = bins%comps(m_idx)%source_mass_c
2840 0 : idx = bins%comps(m_idx)%idx_mass_c
2841 : else
2842 0 : write(iulog,*) subname//': phase= ', phase
2843 0 : call endrun(subname//': unrecognized phase; must be "a" or "c"')
2844 : end if
2845 :
2846 0 : lchnk = state%lchnk
2847 :
2848 0 : select case( source )
2849 : case ('A')
2850 0 : mmr => state%q(:,:,idx)
2851 : case ('N')
2852 0 : call pbuf_get_field(pbuf, idx, mmr)
2853 : case ('Z')
2854 0 : mmr => zero_cols
2855 : end select
2856 :
2857 0 : end subroutine rad_cnst_get_bin_mmr
2858 :
2859 : !================================================================================================
2860 :
2861 0 : subroutine rad_cnst_get_mode_num(list_idx, mode_idx, phase, state, pbuf, num)
2862 :
2863 : ! Return pointer to number mixing ratio for the aerosol mode from the specified
2864 : ! climate or diagnostic list.
2865 :
2866 : ! Arguments
2867 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2868 : integer, intent(in) :: mode_idx ! mode index
2869 : character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne
2870 : type(physics_state), target, intent(in) :: state
2871 : type(physics_buffer_desc), pointer :: pbuf(:)
2872 : real(r8), pointer :: num(:,:)
2873 :
2874 : ! Local variables
2875 : integer :: m_idx
2876 : integer :: idx
2877 : integer :: lchnk
2878 : character(len=1) :: source
2879 : type(modelist_t), pointer :: mlist
2880 : character(len=*), parameter :: subname = 'rad_cnst_get_mode_num'
2881 : !-----------------------------------------------------------------------------
2882 :
2883 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2884 0 : mlist => ma_list(list_idx)
2885 : else
2886 0 : write(iulog,*) subname//': list_idx =', list_idx
2887 0 : call endrun(subname//': list_idx out of bounds')
2888 : endif
2889 :
2890 : ! Check for valid mode index
2891 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
2892 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
2893 0 : call endrun(subname//': mode list index out of range')
2894 : end if
2895 :
2896 : ! Get the index for the corresponding mode in the mode definition object
2897 0 : m_idx = mlist%idx(mode_idx)
2898 :
2899 : ! Get data source
2900 0 : if (phase == 'a') then
2901 0 : source = modes%comps(m_idx)%source_num_a
2902 0 : idx = modes%comps(m_idx)%idx_num_a
2903 0 : else if (phase == 'c') then
2904 0 : source = modes%comps(m_idx)%source_num_c
2905 0 : idx = modes%comps(m_idx)%idx_num_c
2906 : else
2907 0 : write(iulog,*) subname//': phase= ', phase
2908 0 : call endrun(subname//': unrecognized phase; must be "a" or "c"')
2909 : end if
2910 :
2911 0 : lchnk = state%lchnk
2912 :
2913 0 : select case( source )
2914 : case ('A')
2915 0 : num => state%q(:,:,idx)
2916 : case ('N')
2917 0 : call pbuf_get_field(pbuf, idx, num)
2918 : case ('Z')
2919 0 : num => zero_cols
2920 : end select
2921 :
2922 0 : end subroutine rad_cnst_get_mode_num
2923 :
2924 : !================================================================================================
2925 :
2926 1805080800 : subroutine rad_cnst_get_bin_num(list_idx, bin_idx, phase, state, pbuf, num)
2927 :
2928 : ! Return pointer to number mixing ratio for the aerosol bin from the specified
2929 : ! climate or diagnostic list.
2930 :
2931 : ! Arguments
2932 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
2933 : integer, intent(in) :: bin_idx ! bin index
2934 : character(len=1), intent(in) :: phase ! 'a' for interstitial, 'c' for cloud borne
2935 : type(physics_state), target, intent(in) :: state
2936 : type(physics_buffer_desc), pointer :: pbuf(:)
2937 : real(r8), pointer :: num(:,:)
2938 :
2939 : ! Local variables
2940 : integer :: m_idx
2941 : integer :: idx
2942 : integer :: lchnk
2943 : character(len=1) :: source
2944 : type(binlist_t), pointer :: slist
2945 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_num'
2946 : !-----------------------------------------------------------------------------
2947 :
2948 1805080800 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
2949 1805080800 : slist => sa_list(list_idx)
2950 : else
2951 0 : write(iulog,*) subname//': list_idx =', list_idx
2952 0 : call endrun(subname//': list_idx out of bounds')
2953 : endif
2954 :
2955 : ! Check for valid bin index
2956 1805080800 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
2957 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
2958 0 : call endrun(subname//': bin list index out of range')
2959 : end if
2960 :
2961 : ! Get the index for the corresponding bin in the bin definition object
2962 1805080800 : m_idx = slist%idx(bin_idx)
2963 :
2964 : ! Get data source
2965 1805080800 : if (phase == 'a') then
2966 927462000 : source = bins%comps(m_idx)%source_num_a
2967 927462000 : idx = bins%comps(m_idx)%idx_num_a
2968 877618800 : else if (phase == 'c') then
2969 877618800 : source = bins%comps(m_idx)%source_num_c
2970 877618800 : idx = bins%comps(m_idx)%idx_num_c
2971 : else
2972 0 : write(iulog,*) subname//': phase= ', phase
2973 0 : call endrun(subname//': unrecognized phase; must be "a" or "c"')
2974 : end if
2975 :
2976 1805080800 : lchnk = state%lchnk
2977 :
2978 0 : select case( source )
2979 : case ('A')
2980 0 : num => state%q(:,:,idx)
2981 : case ('N')
2982 1805080800 : call pbuf_get_field(pbuf, idx, num)
2983 : case ('Z')
2984 1805080800 : num => zero_cols
2985 : end select
2986 :
2987 1805080800 : end subroutine rad_cnst_get_bin_num
2988 :
2989 : !================================================================================================
2990 :
2991 0 : subroutine rad_cnst_get_mode_num_idx(mode_idx, cnst_idx)
2992 :
2993 : ! Return constituent index of mode number mixing ratio for the aerosol mode in
2994 : ! the climate list.
2995 :
2996 : ! This is a special routine to allow direct access to information in the
2997 : ! constituent array inside physics parameterizations that have been passed,
2998 : ! and are operating over the entire constituent array. The interstitial phase
2999 : ! is assumed since that's what is contained in the constituent array.
3000 :
3001 : ! Arguments
3002 : integer, intent(in) :: mode_idx ! mode index
3003 : integer, intent(out) :: cnst_idx ! constituent index
3004 :
3005 : ! Local variables
3006 : integer :: m_idx
3007 : character(len=1) :: source
3008 : type(modelist_t), pointer :: mlist
3009 : character(len=*), parameter :: subname = 'rad_cnst_get_mode_num'
3010 : !-----------------------------------------------------------------------------
3011 :
3012 : ! assume climate list
3013 0 : mlist => ma_list(0)
3014 :
3015 : ! Check for valid mode index
3016 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
3017 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
3018 0 : call endrun(subname//': mode list index out of range')
3019 : end if
3020 :
3021 : ! Get the index for the corresponding mode in the mode definition object
3022 0 : m_idx = mlist%idx(mode_idx)
3023 :
3024 : ! Check that source is 'A' which means the index is for the constituent array
3025 0 : source = modes%comps(m_idx)%source_num_a
3026 0 : if (source /= 'A') then
3027 0 : write(iulog,*) subname//': source= ', source
3028 0 : call endrun(subname//': requested mode number index not in constituent array')
3029 : end if
3030 :
3031 : ! Return index in constituent array
3032 0 : cnst_idx = modes%comps(m_idx)%idx_num_a
3033 :
3034 0 : end subroutine rad_cnst_get_mode_num_idx
3035 :
3036 : !================================================================================================
3037 :
3038 0 : subroutine rad_cnst_get_bin_num_idx(bin_idx, cnst_idx)
3039 :
3040 : ! Return constituent index of bin number mixing ratio for the aerosol bin in
3041 : ! the climate list.
3042 :
3043 : ! This is a special routine to allow direct access to information in the
3044 : ! constituent array inside physics parameterizations that have been passed,
3045 : ! and are operating over the entire constituent array. The interstitial phase
3046 : ! is assumed since that's what is contained in the constituent array.
3047 :
3048 : ! Arguments
3049 : integer, intent(in) :: bin_idx ! bin index
3050 : integer, intent(out) :: cnst_idx ! constituent index
3051 :
3052 : ! Local variables
3053 : integer :: b_idx
3054 : character(len=1) :: source
3055 : type(binlist_t), pointer :: slist
3056 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_num_idx'
3057 : !-----------------------------------------------------------------------------
3058 :
3059 : ! assume climate list
3060 0 : slist => sa_list(0)
3061 :
3062 : ! Check for valid bin index
3063 0 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
3064 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
3065 0 : call endrun(subname//': bin list index out of range')
3066 : end if
3067 :
3068 : ! Get the index for the corresponding bin in the bin definition object
3069 0 : b_idx = slist%idx(bin_idx)
3070 :
3071 : ! Check that source is 'A' which means the index is for the constituent array
3072 0 : source = bins%comps(b_idx)%source_num_a
3073 0 : if (source /= 'A') then
3074 0 : write(iulog,*) subname//': source= ', source
3075 0 : call endrun(subname//': requested bin number index not in constituent array')
3076 : end if
3077 :
3078 : ! Return index in constituent array
3079 0 : cnst_idx = bins%comps(b_idx)%idx_num_a
3080 :
3081 0 : end subroutine rad_cnst_get_bin_num_idx
3082 :
3083 : !================================================================================================
3084 :
3085 : integer function rad_cnst_get_aer_idx(list_idx, aer_name)
3086 :
3087 : ! Return the index of aerosol aer_name in the list specified by list_idx.
3088 :
3089 : ! Arguments
3090 : integer, intent(in) :: list_idx ! 0 for climate list, 1-N_DIAG for diagnostic lists
3091 : character(len=*), intent(in) :: aer_name ! aerosol name (in state or pbuf)
3092 :
3093 : ! Local variables
3094 : integer :: i, aer_idx
3095 : type(aerlist_t), pointer :: aerlist
3096 : character(len=*), parameter :: subname = "rad_cnst_get_aer_idx"
3097 : !-------------------------------------------------------------------------
3098 :
3099 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3100 : aerlist => aerosollist(list_idx)
3101 : else
3102 : write(iulog,*) subname//': list_idx =', list_idx
3103 : call endrun(subname//': list_idx out of bounds')
3104 : endif
3105 :
3106 : ! Get index in aerosol list for requested name
3107 : aer_idx = -1
3108 : do i = 1, aerlist%numaerosols
3109 : if (trim(aer_name) == trim(aerlist%aer(i)%camname)) then
3110 : aer_idx = i
3111 : exit
3112 : end if
3113 : end do
3114 :
3115 : if (aer_idx == -1) call endrun(subname//": ERROR - name not found")
3116 :
3117 : rad_cnst_get_aer_idx = aer_idx
3118 :
3119 : end function rad_cnst_get_aer_idx
3120 :
3121 : !================================================================================================
3122 :
3123 0 : subroutine rad_cnst_get_aer_props_by_idx(list_idx, &
3124 0 : aer_idx, opticstype, &
3125 : sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, &
3126 : sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, &
3127 : sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, &
3128 : refindex_aer_sw, refindex_aer_lw, &
3129 : r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, &
3130 0 : aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, num_to_mass_aer)
3131 :
3132 : ! Return requested properties for the aerosol from the specified
3133 : ! climate or diagnostic list.
3134 :
3135 : use phys_prop, only: physprop_get
3136 :
3137 :
3138 : ! Arguments
3139 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
3140 : integer, intent(in) :: aer_idx ! index of the aerosol
3141 : character(len=ot_length), optional, intent(out) :: opticstype
3142 : real(r8), optional, pointer :: sw_hygro_ext(:,:)
3143 : real(r8), optional, pointer :: sw_hygro_ssa(:,:)
3144 : real(r8), optional, pointer :: sw_hygro_asm(:,:)
3145 : real(r8), optional, pointer :: lw_hygro_ext(:,:)
3146 : real(r8), optional, pointer :: sw_nonhygro_ext(:)
3147 : real(r8), optional, pointer :: sw_nonhygro_ssa(:)
3148 : real(r8), optional, pointer :: sw_nonhygro_asm(:)
3149 : real(r8), optional, pointer :: sw_nonhygro_scat(:)
3150 : real(r8), optional, pointer :: sw_nonhygro_ascat(:)
3151 : real(r8), optional, pointer :: lw_ext(:)
3152 : complex(r8), optional, pointer :: refindex_aer_sw(:)
3153 : complex(r8), optional, pointer :: refindex_aer_lw(:)
3154 : character(len=20), optional, intent(out) :: aername
3155 : real(r8), optional, intent(out) :: density_aer
3156 : real(r8), optional, intent(out) :: hygro_aer
3157 : real(r8), optional, intent(out) :: dryrad_aer
3158 : real(r8), optional, intent(out) :: dispersion_aer
3159 : real(r8), optional, intent(out) :: num_to_mass_aer
3160 :
3161 : real(r8), optional, pointer :: r_sw_ext(:,:)
3162 : real(r8), optional, pointer :: r_sw_scat(:,:)
3163 : real(r8), optional, pointer :: r_sw_ascat(:,:)
3164 : real(r8), optional, pointer :: r_lw_abs(:,:)
3165 : real(r8), optional, pointer :: mu(:)
3166 :
3167 : ! Local variables
3168 : integer :: id
3169 : character(len=*), parameter :: subname = 'rad_cnst_get_aer_props_by_idx'
3170 : type(aerlist_t), pointer :: aerlist
3171 : !------------------------------------------------------------------------------------
3172 :
3173 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3174 0 : aerlist => aerosollist(list_idx)
3175 : else
3176 0 : write(iulog,*) subname//': list_idx = ', list_idx
3177 0 : call endrun(subname//': list_idx out of range')
3178 : endif
3179 :
3180 0 : if (aer_idx < 1 .or. aer_idx > aerlist%numaerosols) then
3181 0 : write(iulog,*) subname//': aerosol list index out of range: ', aer_idx ,' list index: ',list_idx
3182 0 : call endrun(subname//': aer_idx out of range')
3183 : end if
3184 :
3185 0 : id = aerlist%aer(aer_idx)%physprop_id
3186 :
3187 0 : if (present(opticstype)) call physprop_get(id, opticstype=opticstype)
3188 :
3189 0 : if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
3190 0 : if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
3191 0 : if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
3192 0 : if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
3193 :
3194 0 : if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
3195 0 : if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
3196 0 : if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
3197 0 : if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
3198 0 : if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
3199 0 : if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext)
3200 :
3201 0 : if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
3202 0 : if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
3203 :
3204 0 : if (present(aername)) call physprop_get(id, aername=aername)
3205 0 : if (present(density_aer)) call physprop_get(id, density_aer=density_aer)
3206 0 : if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer)
3207 0 : if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer)
3208 0 : if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer)
3209 0 : if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
3210 :
3211 0 : if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs)
3212 0 : if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext)
3213 0 : if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat)
3214 0 : if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat)
3215 0 : if (present(mu)) call physprop_get(id, mu=mu)
3216 :
3217 0 : end subroutine rad_cnst_get_aer_props_by_idx
3218 :
3219 : !================================================================================================
3220 :
3221 0 : subroutine rad_cnst_get_mam_props_by_idx(list_idx, &
3222 0 : mode_idx, spec_idx, opticstype, &
3223 : sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, &
3224 : sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, &
3225 : sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, &
3226 : refindex_aer_sw, refindex_aer_lw, &
3227 : r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, &
3228 0 : aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, &
3229 0 : num_to_mass_aer, spectype)
3230 :
3231 : ! Return requested properties for the aerosol from the specified
3232 : ! climate or diagnostic list.
3233 :
3234 0 : use phys_prop, only: physprop_get
3235 :
3236 : ! Arguments
3237 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
3238 : integer, intent(in) :: mode_idx ! mode index
3239 : integer, intent(in) :: spec_idx ! index of specie in the mode
3240 : character(len=ot_length), optional, intent(out) :: opticstype
3241 : real(r8), optional, pointer :: sw_hygro_ext(:,:)
3242 : real(r8), optional, pointer :: sw_hygro_ssa(:,:)
3243 : real(r8), optional, pointer :: sw_hygro_asm(:,:)
3244 : real(r8), optional, pointer :: lw_hygro_ext(:,:)
3245 : real(r8), optional, pointer :: sw_nonhygro_ext(:)
3246 : real(r8), optional, pointer :: sw_nonhygro_ssa(:)
3247 : real(r8), optional, pointer :: sw_nonhygro_asm(:)
3248 : real(r8), optional, pointer :: sw_nonhygro_scat(:)
3249 : real(r8), optional, pointer :: sw_nonhygro_ascat(:)
3250 : real(r8), optional, pointer :: lw_ext(:)
3251 : complex(r8), optional, pointer :: refindex_aer_sw(:)
3252 : complex(r8), optional, pointer :: refindex_aer_lw(:)
3253 :
3254 : real(r8), optional, pointer :: r_sw_ext(:,:)
3255 : real(r8), optional, pointer :: r_sw_scat(:,:)
3256 : real(r8), optional, pointer :: r_sw_ascat(:,:)
3257 : real(r8), optional, pointer :: r_lw_abs(:,:)
3258 : real(r8), optional, pointer :: mu(:)
3259 :
3260 : character(len=20), optional, intent(out) :: aername
3261 : real(r8), optional, intent(out) :: density_aer
3262 : real(r8), optional, intent(out) :: hygro_aer
3263 : real(r8), optional, intent(out) :: dryrad_aer
3264 : real(r8), optional, intent(out) :: dispersion_aer
3265 : real(r8), optional, intent(out) :: num_to_mass_aer
3266 : character(len=32), optional, intent(out) :: spectype
3267 :
3268 : ! Local variables
3269 : integer :: m_idx, id
3270 : type(modelist_t), pointer :: mlist
3271 : character(len=*), parameter :: subname = 'rad_cnst_get_mam_props_by_idx'
3272 : !------------------------------------------------------------------------------------
3273 :
3274 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3275 0 : mlist => ma_list(list_idx)
3276 : else
3277 0 : write(iulog,*) subname//': list_idx = ', list_idx
3278 0 : call endrun(subname//': list_idx out of range')
3279 : endif
3280 :
3281 : ! Check for valid mode index
3282 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
3283 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
3284 0 : call endrun(subname//': mode list index out of range')
3285 : end if
3286 :
3287 : ! Get the index for the corresponding mode in the mode definition object
3288 0 : m_idx = mlist%idx(mode_idx)
3289 :
3290 : ! Check for valid specie index
3291 0 : if (spec_idx < 1 .or. spec_idx > modes%comps(m_idx)%nspec) then
3292 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', modes%comps(m_idx)%nspec
3293 0 : call endrun(subname//': specie list index out of range')
3294 : end if
3295 :
3296 0 : id = modes%comps(m_idx)%idx_props(spec_idx)
3297 :
3298 0 : if (present(opticstype)) call physprop_get(id, opticstype=opticstype)
3299 :
3300 0 : if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
3301 0 : if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
3302 0 : if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
3303 0 : if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
3304 :
3305 0 : if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
3306 0 : if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
3307 0 : if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
3308 0 : if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
3309 0 : if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
3310 0 : if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext)
3311 :
3312 0 : if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
3313 0 : if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
3314 :
3315 0 : if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs)
3316 0 : if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext)
3317 0 : if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat)
3318 0 : if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat)
3319 0 : if (present(mu)) call physprop_get(id, mu=mu)
3320 :
3321 0 : if (present(aername)) call physprop_get(id, aername=aername)
3322 0 : if (present(density_aer)) call physprop_get(id, density_aer=density_aer)
3323 0 : if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer)
3324 0 : if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer)
3325 0 : if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer)
3326 0 : if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
3327 :
3328 0 : if (present(spectype)) spectype = modes%comps(m_idx)%type(spec_idx)
3329 :
3330 0 : end subroutine rad_cnst_get_mam_props_by_idx
3331 :
3332 : !================================================================================================
3333 :
3334 52794374179 : subroutine rad_cnst_get_bin_props_by_idx(list_idx, &
3335 0 : bin_idx, spec_idx, opticstype, &
3336 : sw_hygro_ext, sw_hygro_ssa, sw_hygro_asm, lw_hygro_ext, &
3337 : sw_nonhygro_ext, sw_nonhygro_ssa, sw_nonhygro_asm, &
3338 : sw_nonhygro_scat, sw_nonhygro_ascat, lw_ext, &
3339 : refindex_aer_sw, refindex_aer_lw, &
3340 : r_sw_ext, r_sw_scat, r_sw_ascat, r_lw_abs, mu, &
3341 0 : aername, density_aer, hygro_aer, dryrad_aer, dispersion_aer, &
3342 0 : num_to_mass_aer, spectype, specmorph)
3343 :
3344 : ! Return requested properties for the aerosol from the specified
3345 : ! climate or diagnostic list.
3346 :
3347 0 : use phys_prop, only: physprop_get
3348 :
3349 : ! Arguments
3350 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
3351 : integer, intent(in) :: bin_idx ! mode index
3352 : integer, intent(in) :: spec_idx ! index of specie in the mode
3353 : character(len=ot_length), optional, intent(out) :: opticstype
3354 : real(r8), optional, pointer :: sw_hygro_ext(:,:)
3355 : real(r8), optional, pointer :: sw_hygro_ssa(:,:)
3356 : real(r8), optional, pointer :: sw_hygro_asm(:,:)
3357 : real(r8), optional, pointer :: lw_hygro_ext(:,:)
3358 : real(r8), optional, pointer :: sw_nonhygro_ext(:)
3359 : real(r8), optional, pointer :: sw_nonhygro_ssa(:)
3360 : real(r8), optional, pointer :: sw_nonhygro_asm(:)
3361 : real(r8), optional, pointer :: sw_nonhygro_scat(:)
3362 : real(r8), optional, pointer :: sw_nonhygro_ascat(:)
3363 : real(r8), optional, pointer :: lw_ext(:)
3364 : complex(r8), optional, pointer :: refindex_aer_sw(:)
3365 : complex(r8), optional, pointer :: refindex_aer_lw(:)
3366 :
3367 : real(r8), optional, pointer :: r_sw_ext(:,:)
3368 : real(r8), optional, pointer :: r_sw_scat(:,:)
3369 : real(r8), optional, pointer :: r_sw_ascat(:,:)
3370 : real(r8), optional, pointer :: r_lw_abs(:,:)
3371 : real(r8), optional, pointer :: mu(:)
3372 :
3373 : character(len=20), optional, intent(out) :: aername
3374 : real(r8), optional, intent(out) :: density_aer
3375 : real(r8), optional, intent(out) :: hygro_aer
3376 : real(r8), optional, intent(out) :: dryrad_aer
3377 : real(r8), optional, intent(out) :: dispersion_aer
3378 : real(r8), optional, intent(out) :: num_to_mass_aer
3379 : character(len=32), optional, intent(out) :: spectype
3380 : character(len=32), optional, intent(out) :: specmorph
3381 :
3382 : ! Local variables
3383 : integer :: m_idx, id
3384 : type(binlist_t), pointer :: slist
3385 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_props_by_idx'
3386 : !------------------------------------------------------------------------------------
3387 :
3388 52794374179 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3389 52794374179 : slist => sa_list(list_idx)
3390 : else
3391 0 : write(iulog,*) subname//': list_idx = ', list_idx
3392 0 : call endrun(subname//': list_idx out of range')
3393 : endif
3394 :
3395 : ! Check for valid mode index
3396 52794374179 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
3397 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
3398 0 : call endrun(subname//': bin list index out of range')
3399 : end if
3400 :
3401 : ! Get the index for the corresponding mode in the mode definition object
3402 52794374179 : m_idx = slist%idx(bin_idx)
3403 :
3404 : ! Check for valid specie index
3405 52794374179 : if (spec_idx < 1 .or. spec_idx > bins%comps(m_idx)%nspec) then
3406 0 : write(iulog,*) subname//': spec_idx= ', spec_idx, ' nspec= ', bins%comps(m_idx)%nspec
3407 0 : call endrun(subname//': specie list index out of range')
3408 : end if
3409 :
3410 52794374179 : id = bins%comps(m_idx)%idx_props(spec_idx)
3411 :
3412 52794374179 : if (present(opticstype)) call physprop_get(id, opticstype=opticstype)
3413 :
3414 52794374179 : if (present(sw_hygro_ext)) call physprop_get(id, sw_hygro_ext=sw_hygro_ext)
3415 52794374179 : if (present(sw_hygro_ssa)) call physprop_get(id, sw_hygro_ssa=sw_hygro_ssa)
3416 52794374179 : if (present(sw_hygro_asm)) call physprop_get(id, sw_hygro_asm=sw_hygro_asm)
3417 52794374179 : if (present(lw_hygro_ext)) call physprop_get(id, lw_hygro_abs=lw_hygro_ext)
3418 :
3419 52794374179 : if (present(sw_nonhygro_ext)) call physprop_get(id, sw_nonhygro_ext=sw_nonhygro_ext)
3420 52794374179 : if (present(sw_nonhygro_ssa)) call physprop_get(id, sw_nonhygro_ssa=sw_nonhygro_ssa)
3421 52794374179 : if (present(sw_nonhygro_asm)) call physprop_get(id, sw_nonhygro_asm=sw_nonhygro_asm)
3422 52794374179 : if (present(sw_nonhygro_scat)) call physprop_get(id, sw_nonhygro_scat=sw_nonhygro_scat)
3423 52794374179 : if (present(sw_nonhygro_ascat)) call physprop_get(id, sw_nonhygro_ascat=sw_nonhygro_ascat)
3424 52794374179 : if (present(lw_ext)) call physprop_get(id, lw_abs=lw_ext)
3425 :
3426 52794374179 : if (present(refindex_aer_sw)) call physprop_get(id, refindex_aer_sw=refindex_aer_sw)
3427 52794374179 : if (present(refindex_aer_lw)) call physprop_get(id, refindex_aer_lw=refindex_aer_lw)
3428 :
3429 52794374179 : if (present(r_lw_abs)) call physprop_get(id, r_lw_abs=r_lw_abs)
3430 52794374179 : if (present(r_sw_ext)) call physprop_get(id, r_sw_ext=r_sw_ext)
3431 52794374179 : if (present(r_sw_scat)) call physprop_get(id, r_sw_scat=r_sw_scat)
3432 52794374179 : if (present(r_sw_ascat)) call physprop_get(id, r_sw_ascat=r_sw_ascat)
3433 52794374179 : if (present(mu)) call physprop_get(id, mu=mu)
3434 :
3435 52794374179 : if (present(aername)) call physprop_get(id, aername=aername)
3436 52794374179 : if (present(density_aer)) call physprop_get(id, density_aer=density_aer)
3437 52794374179 : if (present(hygro_aer)) call physprop_get(id, hygro_aer=hygro_aer)
3438 52794374179 : if (present(dryrad_aer)) call physprop_get(id, dryrad_aer=dryrad_aer)
3439 52794374179 : if (present(dispersion_aer)) call physprop_get(id, dispersion_aer=dispersion_aer)
3440 52794374179 : if (present(num_to_mass_aer)) call physprop_get(id, num_to_mass_aer=num_to_mass_aer)
3441 :
3442 52794374179 : if (present(spectype)) spectype = bins%comps(m_idx)%type(spec_idx)
3443 52794374179 : if (present(specmorph)) specmorph = bins%comps(m_idx)%morph(spec_idx)
3444 :
3445 52794374179 : end subroutine rad_cnst_get_bin_props_by_idx
3446 :
3447 : !================================================================================================
3448 :
3449 0 : subroutine rad_cnst_get_mode_props(list_idx, mode_idx, opticstype, &
3450 : extpsw, abspsw, asmpsw, absplw, refrtabsw, &
3451 : refitabsw, refrtablw, refitablw, ncoef, prefr, &
3452 : prefi, sigmag, dgnum, dgnumlo, dgnumhi, &
3453 : rhcrystal, rhdeliques)
3454 :
3455 : ! Return requested properties for the mode from the specified
3456 : ! climate or diagnostic list.
3457 :
3458 52794374179 : use phys_prop, only: physprop_get
3459 :
3460 : ! Arguments
3461 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
3462 : integer, intent(in) :: mode_idx ! mode index
3463 :
3464 : character(len=ot_length), optional, intent(out) :: opticstype
3465 : real(r8), optional, pointer :: extpsw(:,:,:,:)
3466 : real(r8), optional, pointer :: abspsw(:,:,:,:)
3467 : real(r8), optional, pointer :: asmpsw(:,:,:,:)
3468 : real(r8), optional, pointer :: absplw(:,:,:,:)
3469 : real(r8), optional, pointer :: refrtabsw(:,:)
3470 : real(r8), optional, pointer :: refitabsw(:,:)
3471 : real(r8), optional, pointer :: refrtablw(:,:)
3472 : real(r8), optional, pointer :: refitablw(:,:)
3473 : integer, optional, intent(out) :: ncoef
3474 : integer, optional, intent(out) :: prefr
3475 : integer, optional, intent(out) :: prefi
3476 : real(r8), optional, intent(out) :: sigmag
3477 : real(r8), optional, intent(out) :: dgnum
3478 : real(r8), optional, intent(out) :: dgnumlo
3479 : real(r8), optional, intent(out) :: dgnumhi
3480 : real(r8), optional, intent(out) :: rhcrystal
3481 : real(r8), optional, intent(out) :: rhdeliques
3482 :
3483 : ! Local variables
3484 : integer :: id
3485 : type(modelist_t), pointer :: mlist
3486 : character(len=*), parameter :: subname = 'rad_cnst_get_mode_props'
3487 : !------------------------------------------------------------------------------------
3488 :
3489 0 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3490 0 : mlist => ma_list(list_idx)
3491 : else
3492 0 : write(iulog,*) subname//': list_idx = ', list_idx
3493 0 : call endrun(subname//': list_idx out of range')
3494 : endif
3495 :
3496 : ! Check for valid mode index
3497 0 : if (mode_idx < 1 .or. mode_idx > mlist%nmodes) then
3498 0 : write(iulog,*) subname//': mode_idx= ', mode_idx, ' nmodes= ', mlist%nmodes
3499 0 : call endrun(subname//': mode list index out of range')
3500 : end if
3501 :
3502 : ! Get the physprop index for the requested mode
3503 0 : id = mlist%idx_props(mode_idx)
3504 :
3505 0 : if (present(opticstype)) call physprop_get(id, opticstype=opticstype)
3506 0 : if (present(extpsw)) call physprop_get(id, extpsw=extpsw)
3507 0 : if (present(abspsw)) call physprop_get(id, abspsw=abspsw)
3508 0 : if (present(asmpsw)) call physprop_get(id, asmpsw=asmpsw)
3509 0 : if (present(absplw)) call physprop_get(id, absplw=absplw)
3510 :
3511 0 : if (present(refrtabsw)) call physprop_get(id, refrtabsw=refrtabsw)
3512 0 : if (present(refitabsw)) call physprop_get(id, refitabsw=refitabsw)
3513 0 : if (present(refrtablw)) call physprop_get(id, refrtablw=refrtablw)
3514 0 : if (present(refitablw)) call physprop_get(id, refitablw=refitablw)
3515 :
3516 0 : if (present(ncoef)) call physprop_get(id, ncoef=ncoef)
3517 0 : if (present(prefr)) call physprop_get(id, prefr=prefr)
3518 0 : if (present(prefi)) call physprop_get(id, prefi=prefi)
3519 0 : if (present(sigmag)) call physprop_get(id, sigmag=sigmag)
3520 0 : if (present(dgnum)) call physprop_get(id, dgnum=dgnum)
3521 0 : if (present(dgnumlo)) call physprop_get(id, dgnumlo=dgnumlo)
3522 0 : if (present(dgnumhi)) call physprop_get(id, dgnumhi=dgnumhi)
3523 0 : if (present(rhcrystal)) call physprop_get(id, rhcrystal=rhcrystal)
3524 0 : if (present(rhdeliques)) call physprop_get(id, rhdeliques=rhdeliques)
3525 :
3526 0 : end subroutine rad_cnst_get_mode_props
3527 :
3528 : !================================================================================================
3529 :
3530 0 : subroutine rad_cnst_get_bin_props(list_idx, bin_idx, opticstype, &
3531 : extpsw, abspsw, asmpsw, absplw, corefrac, nfrac, &
3532 : wgtpct, nwtp, bcdust, nbcdust, kap, nkap, relh, nrelh, &
3533 : sw_hygro_ext_wtp, sw_hygro_ssa_wtp, sw_hygro_asm_wtp, lw_hygro_ext_wtp, &
3534 : sw_hygro_coreshell_ext, sw_hygro_coreshell_ssa, sw_hygro_coreshell_asm, lw_hygro_coreshell_ext, dryrad )
3535 :
3536 : ! Return requested properties for the bin from the specified
3537 : ! climate or diagnostic list.
3538 :
3539 0 : use phys_prop, only: physprop_get
3540 :
3541 : ! Arguments
3542 : integer, intent(in) :: list_idx ! index of the climate or a diagnostic list
3543 : integer, intent(in) :: bin_idx ! mode index
3544 :
3545 : character(len=ot_length), optional, intent(out) :: opticstype
3546 :
3547 : real(r8), optional, pointer :: extpsw(:,:)
3548 : real(r8), optional, pointer :: abspsw(:,:)
3549 : real(r8), optional, pointer :: asmpsw(:,:)
3550 : real(r8), optional, pointer :: absplw(:,:)
3551 : real(r8), optional, pointer :: corefrac(:)
3552 : integer, optional, intent(out) :: nfrac
3553 :
3554 : real(r8), optional, pointer :: sw_hygro_ext_wtp(:,:)
3555 : real(r8), optional, pointer :: sw_hygro_ssa_wtp(:,:)
3556 : real(r8), optional, pointer :: sw_hygro_asm_wtp(:,:)
3557 : real(r8), optional, pointer :: lw_hygro_ext_wtp(:,:)
3558 : real(r8), optional, pointer :: sw_hygro_coreshell_ext(:,:,:,:,:) ! Pengfei Yu Mar.30
3559 : real(r8), optional, pointer :: sw_hygro_coreshell_ssa(:,:,:,:,:)
3560 : real(r8), optional, pointer :: sw_hygro_coreshell_asm(:,:,:,:,:)
3561 : real(r8), optional, pointer :: lw_hygro_coreshell_ext(:,:,:,:,:)
3562 : real(r8), optional, pointer :: wgtpct(:)
3563 : real(r8), optional, pointer :: bcdust(:)
3564 : real(r8), optional, pointer :: kap(:)
3565 : real(r8), optional, pointer :: relh(:)
3566 : integer, optional, intent(out) :: nwtp
3567 : integer, optional, intent(out) :: nbcdust
3568 : integer, optional, intent(out) :: nkap
3569 : integer, optional, intent(out) :: nrelh
3570 : real(r8), optional, intent(out) :: dryrad
3571 :
3572 : ! Local variables
3573 : integer :: id
3574 : type(binlist_t), pointer :: slist
3575 : character(len=*), parameter :: subname = 'rad_cnst_get_bin_props'
3576 : !------------------------------------------------------------------------------------
3577 :
3578 9216000 : if (list_idx >= 0 .and. list_idx <= N_DIAG) then
3579 9216000 : slist => sa_list(list_idx)
3580 : else
3581 0 : write(iulog,*) subname//': list_idx = ', list_idx
3582 0 : call endrun(subname//': list_idx out of range')
3583 : endif
3584 :
3585 : ! Check for valid mode index
3586 9216000 : if (bin_idx < 1 .or. bin_idx > slist%nbins) then
3587 0 : write(iulog,*) subname//': bin_idx= ', bin_idx, ' nbins= ', slist%nbins
3588 0 : call endrun(subname//': bin list index out of range')
3589 : end if
3590 :
3591 : ! Get the physprop index for the requested bin
3592 9216000 : id = slist%idx_props(bin_idx)
3593 :
3594 9216000 : if (present(opticstype)) call physprop_get(id, opticstype=opticstype)
3595 9216000 : if (present(extpsw)) call physprop_get(id, extpsw2=extpsw)
3596 9216000 : if (present(abspsw)) call physprop_get(id, abspsw2=abspsw)
3597 9216000 : if (present(asmpsw)) call physprop_get(id, asmpsw2=asmpsw)
3598 9216000 : if (present(absplw)) call physprop_get(id, absplw2=absplw)
3599 9216000 : if (present(corefrac)) call physprop_get(id, corefrac=corefrac)
3600 9216000 : if (present(nfrac)) call physprop_get(id, nfrac=nfrac)
3601 :
3602 9216000 : if (present(sw_hygro_ext_wtp)) call physprop_get(id, sw_hygro_ext_wtp=sw_hygro_ext_wtp)
3603 9216000 : if (present(sw_hygro_ssa_wtp)) call physprop_get(id, sw_hygro_ssa_wtp=sw_hygro_ssa_wtp)
3604 9216000 : if (present(sw_hygro_asm_wtp)) call physprop_get(id, sw_hygro_asm_wtp=sw_hygro_asm_wtp)
3605 9216000 : if (present(lw_hygro_ext_wtp)) call physprop_get(id, lw_hygro_abs_wtp=lw_hygro_ext_wtp)
3606 9216000 : if (present(sw_hygro_coreshell_ext)) call physprop_get(id, sw_hygro_coreshell_ext=sw_hygro_coreshell_ext)
3607 9216000 : if (present(sw_hygro_coreshell_ssa)) call physprop_get(id, sw_hygro_coreshell_ssa=sw_hygro_coreshell_ssa)
3608 9216000 : if (present(sw_hygro_coreshell_asm)) call physprop_get(id, sw_hygro_coreshell_asm=sw_hygro_coreshell_asm)
3609 9216000 : if (present(lw_hygro_coreshell_ext)) call physprop_get(id, lw_hygro_coreshell_abs=lw_hygro_coreshell_ext)
3610 9216000 : if (present(wgtpct)) call physprop_get(id, wgtpct=wgtpct)
3611 9216000 : if (present(bcdust)) call physprop_get(id, bcdust=bcdust)
3612 9216000 : if (present(kap)) call physprop_get(id, kap=kap)
3613 9216000 : if (present(relh)) call physprop_get(id, relh=relh)
3614 9216000 : if (present(nwtp)) call physprop_get(id, nwtp=nwtp)
3615 9216000 : if (present(nbcdust)) call physprop_get(id, nbcdust=nbcdust)
3616 9216000 : if (present(nkap)) call physprop_get(id, nkap=nkap)
3617 9216000 : if (present(nrelh)) call physprop_get(id, nrelh=nrelh)
3618 9216000 : if (present(dryrad)) call physprop_get(id, dryrad_aer=dryrad)
3619 :
3620 9216000 : end subroutine rad_cnst_get_bin_props
3621 :
3622 : !================================================================================================
3623 :
3624 2 : subroutine print_modes(modes)
3625 :
3626 : type(modes_t), intent(inout) :: modes
3627 :
3628 : integer :: i, m
3629 : !---------------------------------------------------------------------------------------------
3630 :
3631 2 : write(iulog,*)' Mode Definitions'
3632 :
3633 2 : do m = 1, modes%nmodes
3634 :
3635 0 : write(iulog,*) nl//' name=',trim(modes%names(m)),' type=',trim(modes%types(m))
3636 0 : write(iulog,*) ' src_a=',trim(modes%comps(m)%source_num_a),' num_a=',trim(modes%comps(m)%camname_num_a), &
3637 0 : ' src_c=',trim(modes%comps(m)%source_num_c),' num_c=',trim(modes%comps(m)%camname_num_c)
3638 :
3639 2 : do i = 1, modes%comps(m)%nspec
3640 :
3641 0 : write(iulog,*) ' src_a=',trim(modes%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(modes%comps(m)%camname_mmr_a(i)), &
3642 0 : ' src_c=',trim(modes%comps(m)%source_mmr_c(i)), ' mmr_c=',trim(modes%comps(m)%camname_mmr_c(i)), &
3643 0 : ' type=',trim(modes%comps(m)%type(i))
3644 0 : write(iulog,*) ' prop file=', trim(modes%comps(m)%props(i))
3645 : end do
3646 :
3647 : end do
3648 :
3649 9216000 : end subroutine print_modes
3650 :
3651 : !================================================================================================
3652 :
3653 2 : subroutine print_bins(bins)
3654 :
3655 : type(bins_t), intent(inout) :: bins
3656 :
3657 : integer :: i, m
3658 : !---------------------------------------------------------------------------------------------
3659 :
3660 2 : write(iulog,*)' Bin Definitions'
3661 :
3662 82 : do m = 1, bins%nbins
3663 :
3664 80 : write(iulog,*) nl//' name=',trim(bins%names(m))
3665 :
3666 362 : do i = 1, bins%comps(m)%nspec
3667 :
3668 280 : write(iulog,*) ' src_a=',trim(bins%comps(m)%source_mmr_a(i)), ' mmr_a=',trim(bins%comps(m)%camname_mmr_a(i)), &
3669 560 : ' type=',trim(bins%comps(m)%type(i))
3670 360 : write(iulog,*) ' prop file=', trim(bins%comps(m)%props(i))
3671 : end do
3672 :
3673 : end do
3674 :
3675 2 : end subroutine print_bins
3676 :
3677 : !================================================================================================
3678 :
3679 2 : subroutine print_lists(gas_list, aer_list, ma_list, sa_list)
3680 :
3681 : ! Print summary of gas, bulk and modal aerosol lists. This is just the information
3682 : ! read from the namelist.
3683 :
3684 : use radconstants, only: gascnst=>gaslist
3685 :
3686 : type(aerlist_t), intent(in) :: aer_list
3687 : type(gaslist_t), intent(in) :: gas_list
3688 : type(modelist_t), intent(in) :: ma_list
3689 : type(binlist_t), intent(in) :: sa_list
3690 :
3691 : integer :: i, id
3692 :
3693 2 : if (len_trim(gas_list%list_id) == 0) then
3694 2 : write(iulog,*) nl//' gas list for climate calculations'
3695 : else
3696 0 : write(iulog,*) nl//' gas list for diag'//gas_list%list_id//' calculations'
3697 : end if
3698 :
3699 18 : do i = 1, nradgas
3700 18 : if (gas_list%gas(i)%source .eq. 'N') then
3701 6 : write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has pbuf name:'//&
3702 12 : trim(gas_list%gas(i)%camname)
3703 10 : else if (gas_list%gas(i)%source .eq. 'A') then
3704 10 : write(iulog,*) ' '//gas_list%gas(i)%source//':'//gascnst(i)//' has constituents name:'//&
3705 20 : trim(gas_list%gas(i)%camname)
3706 : endif
3707 : enddo
3708 :
3709 2 : if (len_trim(aer_list%list_id) == 0) then
3710 2 : write(iulog,*) nl//' bulk aerosol list for climate calculations'
3711 : else
3712 0 : write(iulog,*) nl//' bulk aerosol list for diag'//aer_list%list_id//' calculations'
3713 : end if
3714 :
3715 2 : do i = 1, aer_list%numaerosols
3716 0 : write(iulog,*) ' '//trim(aer_list%aer(i)%source)//':'//trim(aer_list%aer(i)%camname)//&
3717 2 : ' optics and phys props in :'//trim(aer_list%aer(i)%physprop_file)
3718 : enddo
3719 :
3720 2 : if (len_trim(ma_list%list_id) == 0) then
3721 2 : write(iulog,*) nl//' modal aerosol list for climate calculations'
3722 : else
3723 0 : write(iulog,*) nl//' modal aerosol list for diag'//ma_list%list_id//' calculations'
3724 : end if
3725 :
3726 2 : do i = 1, ma_list%nmodes
3727 0 : id = ma_list%idx(i)
3728 2 : write(iulog,*) ' '//trim(modes%names(id))
3729 : enddo
3730 :
3731 2 : if (len_trim(sa_list%list_id) == 0) then
3732 2 : write(iulog,*) nl//' bin aerosol list for climate calculations'
3733 : else
3734 0 : write(iulog,*) nl//' bin aerosol list for diag'//sa_list%list_id//' calculations'
3735 : end if
3736 :
3737 82 : do i = 1, sa_list%nbins
3738 80 : id = sa_list%idx(i)
3739 82 : write(iulog,*) ' '//trim(bins%names(id))
3740 : enddo
3741 :
3742 2 : end subroutine print_lists
3743 :
3744 : !================================================================================================
3745 :
3746 0 : end module rad_constituents
|
