Line data Source code
1 : module modal_aero_data
2 :
3 : !--------------------------------------------------------------
4 : ! ... Basic aerosol mode parameters and arrays
5 : !--------------------------------------------------------------
6 : use shr_kind_mod, only: r8 => shr_kind_r8
7 : use constituents, only: pcnst, cnst_mw, cnst_name, cnst_get_ind, cnst_set_convtran2, &
8 : cnst_set_spec_class, cnst_spec_class_aerosol, cnst_spec_class_undefined, &
9 : cnst_species_class, cnst_spec_class_gas
10 : use physics_buffer, only: pbuf_add_field, dtype_r8
11 : use time_manager, only: is_first_step
12 : use phys_control, only: phys_getopts
13 : use infnan, only: nan, assignment(=)
14 : use cam_logfile, only: iulog
15 : use cam_abortutils, only: endrun
16 : use spmd_utils, only: masterproc
17 : use ppgrid, only: pcols, pver, begchunk, endchunk
18 : use mo_tracname, only: solsym
19 : use chem_mods, only: gas_pcnst
20 : use radconstants, only: nswbands, nlwbands
21 : use shr_const_mod, only: pi => shr_const_pi
22 : use rad_constituents,only: rad_cnst_get_info, rad_cnst_get_aer_props, rad_cnst_get_mode_props
23 : use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk
24 :
25 : implicit none
26 : private
27 :
28 : public :: modal_aero_data_init
29 : public :: modal_aero_data_reg
30 : public :: qqcw_get_field
31 :
32 : integer, public, protected :: nsoa = 0
33 : integer, public, protected :: npoa = 0
34 : integer, public, protected :: nbc = 0
35 : integer, public, protected :: nspec_max = 0
36 : integer, public, protected :: ntot_amode = 0
37 : integer, public, protected :: nSeaSalt=0, nDust=0
38 : integer, public, protected :: nSO4=0, nNH4=0
39 :
40 : !
41 : ! definitions for aerosol chemical components
42 : !
43 :
44 : real(r8), public, protected, allocatable :: specmw_amode(:,:)
45 : character(len=16), public, protected, allocatable :: modename_amode(:)
46 :
47 : integer, public, protected, allocatable :: nspec_amode(:)
48 :
49 : character(len=20), public, protected :: cnst_name_cw( pcnst )
50 :
51 : ! input mprognum_amode, mdiagnum_amode, mprogsfc_amode, mcalcwater_amode
52 : integer, public, protected, allocatable :: mprognum_amode(:)
53 : integer, public, protected, allocatable :: mdiagnum_amode(:)
54 : integer, public, protected, allocatable :: mprogsfc_amode(:)
55 : integer, public, protected, allocatable :: mcalcwater_amode(:)
56 :
57 : ! input dgnum_amode, dgnumlo_amode, dgnumhi_amode (units = m)
58 : real(r8), public, protected, allocatable :: dgnum_amode(:)
59 : real(r8), public, protected, allocatable :: dgnumlo_amode(:)
60 : real(r8), public, protected, allocatable :: dgnumhi_amode(:)
61 : integer, public, protected, allocatable :: mode_size_order(:)
62 :
63 : ! input sigmag_amode
64 : real(r8), public, protected, allocatable :: sigmag_amode(:)
65 :
66 : ! input crystalization and deliquescence points
67 : real(r8), allocatable :: rhcrystal_amode(:)
68 : real(r8), allocatable :: rhdeliques_amode(:)
69 :
70 :
71 : integer, public, protected, allocatable :: &
72 : lmassptr_amode( :, : ), &
73 : lmassptrcw_amode( :, : ), &
74 : numptr_amode( : ), &
75 : numptrcw_amode( : )
76 :
77 : real(r8), public, protected, allocatable :: &
78 : alnsg_amode( : ), &
79 : voltonumb_amode( : ), &
80 : voltonumblo_amode( : ), &
81 : voltonumbhi_amode( : ), &
82 : alnv2n_amode( : ), &
83 : alnv2nlo_amode( : ), &
84 : alnv2nhi_amode( : ), &
85 : specdens_amode(:,:), &
86 : spechygro(:,:)
87 :
88 : integer, public, protected, allocatable :: &
89 : lptr_so4_a_amode(:), lptr_so4_cw_amode(:), &
90 : lptr_msa_a_amode(:), lptr_msa_cw_amode(:), &
91 : lptr_nh4_a_amode(:), lptr_nh4_cw_amode(:), &
92 : lptr_no3_a_amode(:), lptr_no3_cw_amode(:), &
93 : lptr_nacl_a_amode(:), lptr_nacl_cw_amode(:),&
94 : lptr_dust_a_amode(:), lptr_dust_cw_amode(:)
95 :
96 : integer, public, protected :: &
97 : modeptr_accum, modeptr_aitken, &
98 : modeptr_ufine, modeptr_coarse, &
99 : modeptr_pcarbon, &
100 : modeptr_finedust, modeptr_fineseas, &
101 : modeptr_coardust, modeptr_coarseas, modeptr_stracoar
102 :
103 : !2D lptr variables added by RCE to access speciated species
104 : integer, public, protected, allocatable :: &
105 : lptr2_bc_a_amode(:,:), lptr2_bc_cw_amode(:,:), &
106 : lptr2_pom_a_amode(:,:), lptr2_pom_cw_amode(:,:), &
107 : lptr2_soa_a_amode(:,:), lptr2_soa_cw_amode(:,:), &
108 : lptr2_soa_g_amode(:)
109 :
110 : real(r8), public, protected :: specmw_so4_amode
111 :
112 : logical, public, protected :: soa_multi_species = .false.
113 :
114 : character(len=16), allocatable :: xname_massptr(:,:) ! names of species in each mode
115 : character(len=16), allocatable :: xname_massptrcw(:,:) ! names of cloud-borne species in each mode
116 :
117 : complex(r8), allocatable :: &
118 : specrefndxsw( :,:,: ), &
119 : specrefndxlw( :,:,: )
120 :
121 : character(len=8), allocatable :: &
122 : aodvisname(: ), &
123 : ssavisname(: )
124 : character(len=48), allocatable :: &
125 : aodvislongname(: ), &
126 : ssavislongname(: )
127 :
128 : character(len=8), allocatable :: &
129 : fnactname(: ), &
130 : fmactname(: ), &
131 : nactname(: )
132 :
133 : character(len=48), allocatable :: &
134 : fnactlongname(: ), &
135 : fmactlongname(: ), &
136 : nactlongname(: )
137 :
138 :
139 : ! threshold for reporting negatives from subr qneg3
140 : real(r8) :: qneg3_worst_thresh_amode(pcnst)
141 :
142 : integer :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf
143 :
144 : logical :: convproc_do_aer
145 : logical :: cam_do_aero_conv = .true.
146 : contains
147 :
148 : !--------------------------------------------------------------
149 : !--------------------------------------------------------------
150 0 : subroutine modal_aero_data_reg
151 :
152 : character(len=6) :: xname_numptr, xname_numptrcw
153 : character(len=1) :: modechr
154 : integer :: m, l, iptr,i, idx
155 : character(len=3) :: trnum ! used to hold mode number (as characters)
156 :
157 : character(len=32) :: spec_name, mode_type
158 : character(len=1) :: modestr
159 :
160 0 : call rad_cnst_get_info( 0, nmodes=ntot_amode )
161 0 : allocate( nspec_amode(ntot_amode) )
162 0 : allocate( numptr_amode(ntot_amode) )
163 0 : allocate( numptrcw_amode(ntot_amode) )
164 0 : allocate(modename_amode(ntot_amode))
165 0 : allocate(mprognum_amode(ntot_amode))
166 0 : allocate(mdiagnum_amode(ntot_amode))
167 0 : allocate(mprogsfc_amode(ntot_amode))
168 0 : allocate(mcalcwater_amode(ntot_amode))
169 0 : mprognum_amode(:) = 1
170 0 : mdiagnum_amode(:) = 0
171 0 : mprogsfc_amode(:) = 0
172 0 : if (ntot_amode==7) then
173 0 : mcalcwater_amode(:) = 1
174 : else
175 0 : mcalcwater_amode(:) = 0
176 : endif
177 0 : allocate(dgnum_amode(ntot_amode))
178 0 : allocate(mode_size_order(ntot_amode))
179 0 : allocate(dgnumlo_amode(ntot_amode))
180 0 : allocate(dgnumhi_amode(ntot_amode))
181 0 : allocate(sigmag_amode(ntot_amode))
182 0 : allocate(rhcrystal_amode(ntot_amode))
183 0 : allocate(rhdeliques_amode(ntot_amode))
184 : allocate( &
185 0 : alnsg_amode( ntot_amode ), & !
186 0 : voltonumb_amode( ntot_amode ), & !
187 0 : voltonumblo_amode( ntot_amode ), & !
188 0 : voltonumbhi_amode( ntot_amode ), & !
189 0 : alnv2n_amode( ntot_amode ), & !
190 0 : alnv2nlo_amode( ntot_amode ), & !
191 0 : alnv2nhi_amode( ntot_amode ), & !
192 0 : aodvisname(ntot_amode ), &
193 0 : ssavisname(ntot_amode ), &
194 0 : fnactname(ntot_amode ), &
195 0 : fmactname(ntot_amode ), &
196 0 : nactname(ntot_amode ), &
197 0 : fnactlongname(ntot_amode ), &
198 0 : fmactlongname(ntot_amode ), &
199 0 : nactlongname(ntot_amode ), &
200 0 : lptr_so4_a_amode(ntot_amode), lptr_so4_cw_amode(ntot_amode), &
201 0 : lptr_msa_a_amode(ntot_amode), lptr_msa_cw_amode(ntot_amode), &
202 0 : lptr_nh4_a_amode(ntot_amode), lptr_nh4_cw_amode(ntot_amode), &
203 0 : lptr_nacl_a_amode(ntot_amode), lptr_nacl_cw_amode(ntot_amode), &
204 0 : lptr_dust_a_amode(ntot_amode), lptr_dust_cw_amode(ntot_amode), &
205 0 : lptr_no3_a_amode(ntot_amode), lptr_no3_cw_amode(ntot_amode) &
206 0 : )
207 :
208 : allocate( &
209 0 : aodvislongname(ntot_amode ), &
210 0 : ssavislongname(ntot_amode ) &
211 0 : )
212 :
213 0 : do m = 1, ntot_amode
214 0 : call rad_cnst_get_info(0, m, mode_type=mode_type, nspec=nspec_amode(m))
215 0 : modename_amode(m) = mode_type
216 : ! count number of soa, poa, and bc bins in mode 1
217 0 : if (m==1) then
218 0 : do l = 1, nspec_amode(m)
219 0 : call rad_cnst_get_info(0, m, l, spec_name=spec_name )
220 0 : if (spec_name(:3) == 'soa') nsoa=nsoa+1
221 0 : if (spec_name(:3) == 'pom') npoa=npoa+1
222 0 : if (spec_name(:2) == 'bc' ) nbc =nbc +1
223 : enddo
224 : endif
225 : enddo
226 :
227 0 : soa_multi_species = nsoa > 1
228 :
229 0 : nspec_max = maxval( nspec_amode )
230 :
231 0 : allocate ( specdens_amode(nspec_max,ntot_amode) )
232 0 : allocate ( spechygro(nspec_max,ntot_amode) )
233 0 : allocate ( specmw_amode(nspec_max,ntot_amode) )
234 0 : allocate ( xname_massptr(nspec_max,ntot_amode) )
235 0 : allocate ( xname_massptrcw(nspec_max,ntot_amode) )
236 0 : specmw_amode = nan
237 0 : xname_massptr(:,:) = ' '
238 0 : xname_massptrcw(:,:) = ' '
239 :
240 0 : do m = 1, ntot_amode
241 0 : do l = 1, nspec_amode(m)
242 0 : call rad_cnst_get_info(0, m, l, spec_name=spec_name )
243 0 : xname_massptr(l,m) = spec_name
244 0 : write(modestr,'(I1)') m
245 0 : idx = index( xname_massptr(l,m), '_' )
246 0 : xname_massptrcw(l,m) = xname_massptr(l,m)(:idx-1)//'_c'//modestr
247 0 : if (xname_massptr(l,m)(:3) == 'dst') nDust=nDust+1
248 0 : if (xname_massptr(l,m)(:3) == 'ncl') nSeaSalt=nSeaSalt+1
249 0 : if (xname_massptr(l,m)(:3) == 'nh4') nNH4=nNH4+1
250 0 : if (xname_massptr(l,m)(:3) == 'so4') nSO4=nSO4+1
251 : enddo
252 : enddo
253 :
254 : allocate( &
255 0 : lmassptr_amode( nspec_max, ntot_amode ),&
256 0 : lmassptrcw_amode( nspec_max, ntot_amode ),&
257 0 : lptr2_pom_a_amode(ntot_amode,npoa), lptr2_pom_cw_amode(ntot_amode,npoa), &
258 0 : lptr2_soa_a_amode(ntot_amode,nsoa), lptr2_soa_cw_amode(ntot_amode,nsoa), &
259 0 : lptr2_bc_a_amode(ntot_amode,nbc), lptr2_bc_cw_amode(ntot_amode,nbc), &
260 0 : lptr2_soa_g_amode(nsoa) &
261 0 : )
262 0 : lmassptr_amode = -999999
263 0 : lptr2_soa_g_amode = -999999
264 :
265 0 : allocate( specrefndxsw(nswbands,nspec_max,ntot_amode ) )
266 0 : allocate( specrefndxlw(nlwbands,nspec_max,ntot_amode) )
267 :
268 0 : do m = 1, ntot_amode
269 0 : if(nspec_amode(m).gt.nspec_max)then
270 0 : write(iulog,*)'modal_aero_data_reg: nspec_amode(m).gt.nspec_max '
271 0 : write(iulog,*)'modal_aero_data_reg: m,nspec_amode(m), nspec_max=',m, nspec_amode(m), nspec_max
272 0 : call endrun('modal_aero_data_reg: nspec_amode(m).gt.nspec_max ')
273 : end if
274 : end do
275 :
276 0 : call phys_getopts(convproc_do_aer_out = convproc_do_aer)
277 0 : if (convproc_do_aer) cam_do_aero_conv = .false.
278 :
279 0 : do m = 1, ntot_amode
280 0 : write(modechr,fmt='(I1)') m
281 0 : xname_numptr = 'num_a'//modechr
282 0 : xname_numptrcw = 'num_c'//modechr
283 :
284 0 : if (masterproc) then
285 0 : write(iulog,9231) m, modename_amode(m)
286 : write(iulog,9232) &
287 0 : 'nspec ', &
288 0 : nspec_amode(m)
289 : write(iulog,9232) &
290 0 : 'mprognum, mdiagnum, mprogsfc', &
291 0 : mprognum_amode(m), mdiagnum_amode(m), mprogsfc_amode(m)
292 : write(iulog,9232) &
293 0 : 'mcalcwater ', &
294 0 : mcalcwater_amode(m)
295 : endif
296 :
297 : ! define species to hold interstitial & activated number
298 : call search_list_of_names( &
299 0 : xname_numptr, numptr_amode(m), cnst_name, pcnst )
300 0 : if (numptr_amode(m) .le. 0) then
301 0 : write(iulog,9061) 'xname_numptr', xname_numptr, m
302 0 : call endrun('modal_aero_data_reg: numptr_amode(m) .le. 0')
303 : end if
304 0 : if (numptr_amode(m) .gt. pcnst) then
305 0 : write(iulog,9061) 'numptr_amode', numptr_amode(m), m
306 0 : write(iulog,9061) 'xname_numptr', xname_numptr, m
307 0 : call endrun('modal_aero_data_reg: numptr_amode(m) .gt. pcnst')
308 : end if
309 :
310 0 : call cnst_set_spec_class(numptr_amode(m), cnst_spec_class_aerosol)
311 0 : call cnst_set_convtran2(numptr_amode(m), cam_do_aero_conv)
312 :
313 0 : numptrcw_amode(m) = numptr_amode(m) !use the same index for Q and QQCW arrays
314 0 : if (numptrcw_amode(m) .le. 0) then
315 0 : write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m
316 0 : call endrun('modal_aero_data_reg: numptrcw_amode(m) .le. 0')
317 : end if
318 0 : if (numptrcw_amode(m) .gt. pcnst) then
319 0 : write(iulog,9061) 'numptrcw_amode', numptrcw_amode(m), m
320 0 : write(iulog,9061) 'xname_numptrcw', xname_numptrcw, m
321 0 : call endrun('modal_aero_data_reg: numptrcw_amode(m) .gt. pcnst')
322 : end if
323 :
324 0 : call pbuf_add_field(xname_numptrcw,'global',dtype_r8,(/pcols,pver/),iptr)
325 0 : call qqcw_set_ptr(numptrcw_amode(m),iptr)
326 :
327 : ! output mode information
328 0 : if ( masterproc ) then
329 0 : write(iulog,9233) 'numptr ', &
330 0 : numptr_amode(m), xname_numptr
331 0 : write(iulog,9233) 'numptrcw ', &
332 0 : numptrcw_amode(m), xname_numptrcw
333 : end if
334 :
335 : ! define the chemical species for the mode
336 0 : do l = 1, nspec_amode(m)
337 :
338 : call search_list_of_names( &
339 0 : xname_massptr(l,m), lmassptr_amode(l,m), cnst_name, pcnst )
340 0 : if (lmassptr_amode(l,m) .le. 0) then
341 0 : write(iulog,9062) 'xname_massptr', xname_massptr(l,m), l, m
342 0 : write(iulog,'(10(a8,1x))')(cnst_name(i),i=1,pcnst)
343 0 : call endrun('modal_aero_data_reg: lmassptr_amode(l,m) .le. 0')
344 : end if
345 0 : call cnst_set_spec_class(lmassptr_amode(l,m), cnst_spec_class_aerosol)
346 0 : call cnst_set_convtran2(lmassptr_amode(l,m), cam_do_aero_conv)
347 :
348 0 : lmassptrcw_amode(l,m) = lmassptr_amode(l,m) !use the same index for Q and QQCW arrays
349 0 : if (lmassptrcw_amode(l,m) .le. 0) then
350 0 : write(iulog,9062) 'xname_massptrcw', xname_massptrcw(l,m), l, m
351 0 : call endrun('modal_aero_data_reg: lmassptrcw_amode(l,m) .le. 0')
352 : end if
353 0 : call pbuf_add_field(xname_massptrcw(l,m),'global',dtype_r8,(/pcols,pver/),iptr)
354 0 : call qqcw_set_ptr(lmassptrcw_amode(l,m), iptr)
355 :
356 0 : if ( masterproc ) then
357 0 : write(iulog,9236) 'spec, massptr ', l, &
358 0 : lmassptr_amode(l,m), xname_massptr(l,m)
359 0 : write(iulog,9236) 'spec, massptrcw', l, &
360 0 : lmassptrcw_amode(l,m), xname_massptrcw(l,m)
361 : end if
362 :
363 : end do
364 :
365 : ! set names for aodvis and ssavis
366 0 : write(unit=trnum,fmt='(i3)') m+100
367 :
368 0 : aodvisname(m) = 'AODVIS'//trnum(2:3)
369 0 : aodvislongname(m) = 'Aerosol optical depth for mode '//trnum(2:3)
370 0 : ssavisname(m) = 'SSAVIS'//trnum(2:3)
371 0 : ssavislongname(m) = 'Single-scatter albedo for mode '//trnum(2:3)
372 0 : fnactname(m) = 'FNACT'//trnum(2:3)
373 0 : fnactlongname(m) = 'Number faction activated for mode '//trnum(2:3)
374 0 : fmactname(m) = 'FMACT'//trnum(2:3)
375 0 : fmactlongname(m) = 'Fraction mass activated for mode'//trnum(2:3)
376 : end do
377 :
378 : ! At this point, species_class is either undefined or aerosol.
379 : ! For the "chemistry species" set the undefined ones to gas,
380 : ! and leave the aerosol ones as is
381 : do i = 1, gas_pcnst
382 : call cnst_get_ind(solsym(i), idx, abort=.false.)
383 : if (idx > 0) then
384 : if (cnst_species_class(idx) == cnst_spec_class_undefined) then
385 : call cnst_set_spec_class(idx, cnst_spec_class_gas)
386 : end if
387 : end if
388 : end do
389 :
390 0 : if (masterproc) write(iulog,9230)
391 : 9230 format( // '*** init_aer_modes mode definitions' )
392 : 9231 format( 'mode = ', i4, ' = "', a, '"' )
393 : 9232 format( 4x, a, 4(1x, i5 ) )
394 : 9233 format( 4x, a15, 4x, i7, '="', a, '"' )
395 : 9236 format( 4x, a15, i4, i7, '="', a, '"' )
396 : 9061 format( '*** subr modesmodal_aero_data_reg - bad ', a / &
397 : 5x, 'name, m = ', a, 5x, i5 )
398 : 9062 format( '*** subr modal_aero_data_reg - bad ', a / &
399 : 5x, 'name, l, m = ', a, 5x, 2i5 )
400 0 : end subroutine modal_aero_data_reg
401 :
402 : !--------------------------------------------------------------
403 : !--------------------------------------------------------------
404 0 : subroutine modal_aero_data_init(pbuf2d)
405 :
406 : type(physics_buffer_desc), pointer :: pbuf2d(:,:)
407 :
408 : !--------------------------------------------------------------
409 : ! ... local variables
410 : !--------------------------------------------------------------
411 : integer :: l, m, i, lchnk, tmp
412 :
413 : integer :: qArrIndex
414 0 : complex(r8), pointer :: refindex_aer_sw(:), &
415 0 : refindex_aer_lw(:)
416 0 : real(r8), pointer :: qqcw(:,:)
417 : real(r8), parameter :: huge_r8 = huge(1._r8)
418 : character(len=*), parameter :: routine='modal_aero_initialize'
419 : character(len=32) :: spec_type
420 : integer :: soa_ndx
421 :
422 : !-----------------------------------------------------------------------
423 :
424 : ! Mode specific properties.
425 0 : do m = 1, ntot_amode
426 : call rad_cnst_get_mode_props(0, m, &
427 0 : sigmag=sigmag_amode(m), dgnum=dgnum_amode(m), dgnumlo=dgnumlo_amode(m), &
428 0 : dgnumhi=dgnumhi_amode(m), rhcrystal=rhcrystal_amode(m), rhdeliques=rhdeliques_amode(m))
429 :
430 0 : mode_size_order(m) = m
431 :
432 : ! compute frequently used parameters: ln(sigmag),
433 : ! volume-to-number and volume-to-surface conversions, ...
434 0 : alnsg_amode(m) = log( sigmag_amode(m) )
435 :
436 0 : voltonumb_amode(m) = 1._r8 / ( (pi/6._r8)* &
437 0 : (dgnum_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
438 0 : voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* &
439 0 : (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
440 0 : voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* &
441 0 : (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alnsg_amode(m)**2._r8) )
442 :
443 0 : alnv2n_amode(m) = log( voltonumb_amode(m) )
444 0 : alnv2nlo_amode(m) = log( voltonumblo_amode(m) )
445 0 : alnv2nhi_amode(m) = log( voltonumbhi_amode(m) )
446 :
447 : end do
448 :
449 0 : do i = 1, ntot_amode-1 ! order from largest to smallest
450 0 : do m = 2, ntot_amode
451 0 : if (dgnum_amode(mode_size_order(m-1))<dgnum_amode(mode_size_order(m))) then
452 0 : tmp = mode_size_order(m-1)
453 0 : mode_size_order(m-1)= mode_size_order(m)
454 0 : mode_size_order(m) = tmp
455 : endif
456 : enddo
457 : enddo
458 :
459 0 : lptr2_soa_g_amode(:) = -1
460 0 : soa_ndx = 0
461 0 : do i = 1, pcnst
462 0 : if (cnst_name(i)(:4) == 'SOAG' .and. cnst_name(i)(:5) /= 'SOAGX') then
463 0 : soa_ndx = soa_ndx+1
464 0 : lptr2_soa_g_amode(soa_ndx) = i
465 : endif
466 : enddo
467 0 : if (.not.any(lptr2_soa_g_amode>0)) call endrun('modal_aero_data_init: lptr2_soa_g_amode is not set properly')
468 : ! Properties of mode specie types.
469 :
470 : ! values from Koepke, Hess, Schult and Shettle, Global Aerosol Data Set
471 : ! Report #243, Max-Planck Institute for Meteorology, 1997a
472 : ! See also Hess, Koepke and Schult, Optical Properties of Aerosols and Clouds (OPAC)
473 : ! BAMS, 1998.
474 :
475 : ! specrefndxsw(:ntot_aspectype) = (/ (1.53, 0.01), (1.53, 0.01), (1.53, 0.01), &
476 : ! (1.55, 0.01), (1.55, 0.01), (1.90, 0.60), &
477 : ! (1.50, 1.0e-8), (1.50, 0.005) /)
478 : ! specrefndxlw(:ntot_aspectype) = (/ (2.0, 0.5), (2.0, 0.5), (2.0, 0.5), &
479 : ! (1.7, 0.5), (1.7, 0.5), (2.22, 0.73), &
480 : ! (1.50, 0.02), (2.6, 0.6) /)
481 : ! get refractive indices from phys_prop files
482 :
483 : ! The following use of the rad_constituent interfaces makes the assumption that the
484 : ! prognostic modes are used in the mode climate (index 0) list.
485 :
486 0 : if (masterproc) write(iulog,9210)
487 0 : do m = 1, ntot_amode
488 0 : do l = 1, nspec_amode(m)
489 0 : qArrIndex = lmassptr_amode(l,m) !index of the species in the state%q array
490 : call rad_cnst_get_aer_props(0, m, l , &
491 : refindex_aer_sw=refindex_aer_sw, &
492 : refindex_aer_lw=refindex_aer_lw, &
493 0 : density_aer=specdens_amode(l,m), &
494 0 : hygro_aer=spechygro(l,m) )
495 :
496 0 : specmw_amode(l,m) = cnst_mw(qArrIndex)
497 :
498 0 : if(masterproc) then
499 0 : write(iulog,9212) ' name : ', cnst_name(qArrIndex)
500 0 : write(iulog,9213) ' density, MW : ', specdens_amode(l,m), specmw_amode(l,m)
501 0 : write(iulog,9213) ' hygro : ', spechygro(l,m)
502 : endif
503 0 : do i=1,nswbands
504 0 : specrefndxsw(i,l,m)=refindex_aer_sw(i)
505 0 : if(masterproc) write(iulog,9213) 'ref index sw ', (specrefndxsw(i,l,m))
506 : end do
507 0 : do i=1,nlwbands
508 0 : specrefndxlw(i,l,m)=refindex_aer_lw(i)
509 0 : if(masterproc) write(iulog,9213) 'ref index ir ', (specrefndxlw(i,l,m))
510 : end do
511 :
512 : enddo
513 : enddo
514 :
515 : 9210 format( // '*** init_aer_modes aerosol species-types' )
516 : 9211 format( 'spectype =', i4)
517 : 9212 format( 4x, a, 3x, '"', a, '"' )
518 : 9213 format( 4x, a, 5(1pe14.5) )
519 :
520 : ! set cnst_name_cw
521 0 : call initaermodes_set_cnstnamecw()
522 :
523 :
524 : !
525 : ! set the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
526 : !
527 0 : call initaermodes_setspecptrs
528 :
529 : !
530 : ! set threshold for reporting negatives from subr qneg3
531 : ! for aerosol number species set this to
532 : ! 1e3 #/kg ~= 1e-3 #/cm3 for accum, aitken, pcarbon, ufine modes
533 : ! 3e1 #/kg ~= 3e-5 #/cm3 for fineseas and finedust modes
534 : ! 1e0 #/kg ~= 1e-6 #/cm3 for other modes which are coarse
535 : ! for other species, set this to zero so that it will be ignored
536 : ! by qneg3
537 : !
538 0 : if ( masterproc ) write(iulog,'(/a)') &
539 0 : 'mode, modename_amode, qneg3_worst_thresh_amode'
540 0 : qneg3_worst_thresh_amode(:) = 0.0_r8
541 0 : do m = 1, ntot_amode
542 0 : l = numptr_amode(m)
543 0 : if ((l <= 0) .or. (l > pcnst)) cycle
544 :
545 0 : if (m == modeptr_accum) then
546 0 : qneg3_worst_thresh_amode(l) = 1.0e3_r8
547 0 : else if (m == modeptr_aitken) then
548 0 : qneg3_worst_thresh_amode(l) = 1.0e3_r8
549 0 : else if (m == modeptr_pcarbon) then
550 0 : qneg3_worst_thresh_amode(l) = 1.0e3_r8
551 0 : else if (m == modeptr_ufine) then
552 0 : qneg3_worst_thresh_amode(l) = 1.0e3_r8
553 :
554 0 : else if (m == modeptr_fineseas) then
555 0 : qneg3_worst_thresh_amode(l) = 3.0e1_r8
556 0 : else if (m == modeptr_finedust) then
557 0 : qneg3_worst_thresh_amode(l) = 3.0e1_r8
558 :
559 : else
560 0 : qneg3_worst_thresh_amode(l) = 1.0e0_r8
561 : end if
562 :
563 0 : if ( masterproc ) write(iulog,'(i3,2x,a,1p,e12.3)') &
564 0 : m, modename_amode(m), qneg3_worst_thresh_amode(l)
565 : end do
566 :
567 0 : if (is_first_step()) then
568 : ! initialize cloud bourne constituents in physics buffer
569 :
570 0 : do i = 1, pcnst
571 0 : do lchnk = begchunk, endchunk
572 0 : qqcw => qqcw_get_field(pbuf_get_chunk(pbuf2d,lchnk), i, lchnk, .true.)
573 0 : if (associated(qqcw)) then
574 0 : qqcw = 1.e-38_r8
575 : end if
576 : end do
577 : end do
578 : end if
579 :
580 0 : end subroutine modal_aero_data_init
581 :
582 : !--------------------------------------------------------------
583 : !--------------------------------------------------------------
584 0 : subroutine qqcw_set_ptr(index, iptr)
585 : use cam_abortutils, only : endrun
586 :
587 :
588 : integer, intent(in) :: index, iptr
589 :
590 0 : if(index>0 .and. index <= pcnst ) then
591 0 : qqcw(index)=iptr
592 : else
593 0 : call endrun('qqcw_set_ptr: attempting to set qqcw pointer already defined')
594 : end if
595 0 : end subroutine qqcw_set_ptr
596 :
597 : !--------------------------------------------------------------
598 : !--------------------------------------------------------------
599 0 : function qqcw_get_field(pbuf, index, lchnk, errorhandle)
600 : use cam_abortutils, only : endrun
601 : use physics_buffer, only : physics_buffer_desc, pbuf_get_field
602 :
603 : integer, intent(in) :: index, lchnk
604 : real(r8), pointer :: qqcw_get_field(:,:)
605 : logical, optional :: errorhandle
606 : type(physics_buffer_desc), pointer :: pbuf(:)
607 :
608 : logical :: error
609 :
610 0 : nullify(qqcw_get_field)
611 0 : error = .false.
612 0 : if (index>0 .and. index <= pcnst) then
613 0 : if (qqcw(index)>0) then
614 : call pbuf_get_field(pbuf, qqcw(index), qqcw_get_field)
615 : else
616 : error = .true.
617 : endif
618 : else
619 : error = .true.
620 : end if
621 :
622 0 : if (error .and. .not. present(errorhandle)) then
623 0 : call endrun('qqcw_get_field: attempt to access undefined qqcw')
624 : end if
625 :
626 0 : end function qqcw_get_field
627 :
628 : !----------------------------------------------------------------
629 : !
630 : ! nspec_max = maximum allowable number of chemical species
631 : ! in each aerosol mode
632 : !
633 : ! ntot_amode = number of aerosol modes
634 : ! ( ntot_amode_gchm = number of aerosol modes in gchm
635 : ! ntot_amode_ccm2 = number of aerosol modes to be made known to ccm2
636 : ! These are temporary until multi-mode activation scavenging is going.
637 : ! Until then, ntot_amode is set to either ntot_amode_gchm or
638 : ! ntot_amode_ccm2 depending on which code is active )
639 : !
640 : ! msectional - if positive, moving-center sectional code is utilized,
641 : ! and each mode is actually a section.
642 : ! msectional_concinit - if positive, special code is used to initialize
643 : ! the mixing ratios of all the sections.
644 : !
645 : ! nspec_amode(m) = number of chemical species in aerosol mode m
646 : ! nspec_amode_ccm2(m) = . . . while in ccm2 code
647 : ! nspec_amode_gchm(m) = . . . while in gchm code
648 : ! nspec_amode_nontracer(m) = number of "non-tracer" chemical
649 : ! species while in gchm code
650 : ! lspectype_amode(l,m) = species type/i.d. for chemical species l
651 : ! in aerosol mode m. (1=sulfate, others to be defined)
652 : ! lmassptr_amode(l,m) = gchm r-array index for the mixing ratio
653 : ! (moles-x/mole-air) for chemical species l in aerosol mode m
654 : ! that is in clear air or interstitial air (but not in cloud water)
655 : ! lmassptrcw_amode(l,m) = gchm r-array index for the mixing ratio
656 : ! (moles-x/mole-air) for chemical species l in aerosol mode m
657 : ! that is currently bound/dissolved in cloud water
658 : ! lwaterptr_amode(m) = gchm r-array index for the mixing ratio
659 : ! (moles-water/mole-air) for water associated with aerosol mode m
660 : ! that is in clear air or interstitial air
661 : ! lkohlercptr_amode(m) = gchm r-array index for the kohler "c" parameter
662 : ! for aerosol mode m. This is defined on a per-dry-particle-mass basis:
663 : ! c = r(i,j,k,lkohlercptr_amode) * [rhodry * (4*pi/3) * rdry^3]
664 : ! numptr_amode(m) = gchm r-array index for the number mixing ratio
665 : ! (particles/mole-air) for aerosol mode m that is in clear air or
666 : ! interstitial are (but not in cloud water). If zero or negative,
667 : ! then number is not being simulated.
668 : ! ( numptr_amode_gchm(m) = same thing but for within gchm
669 : ! numptr_amode_ccm2(m) = same thing but for within ccm2
670 : ! These are temporary, to allow testing number in gchm before ccm2 )
671 : ! numptrcw_amode(m) = gchm r-array index for the number mixing ratio
672 : ! (particles/mole-air) for aerosol mode m
673 : ! that is currently bound/dissolved in cloud water
674 : ! lsfcptr_amode(m) = gchm r-array index for the surface area mixing ratio
675 : ! (cm^2/mole-air) for aerosol mode m that is in clear air or
676 : ! interstitial are (but not in cloud water). If zero or negative,
677 : ! then surface area is not being simulated.
678 : ! lsfcptrcw_amode(m) = gchm r-array index for the surface area mixing ratio
679 : ! (cm^2/mole-air) for aerosol mode m that is currently
680 : ! bound/dissolved in cloud water.
681 : ! lsigptr_amode(m) = gchm r-array index for sigmag for aerosol mode m
682 : ! that is in clear air or interstitial are (but not in cloud water).
683 : ! If zero or negative, then the constant sigmag_amode(m) is used.
684 : ! lsigptrcw_amode(m) = gchm r-array index for sigmag for aerosol mode m
685 : ! that is currently bound/dissolved in cloud water.
686 : ! If zero or negative, then the constant sigmag_amode(m) is used.
687 : ! lsigptrac_amode(m) = gchm r-array index for sigmag for aerosol mode m
688 : ! for combined clear-air/interstial plus bound/dissolved in cloud water.
689 : ! If zero or negative, then the constant sigmag_amode(m) is used.
690 : !
691 : ! dgnum_amode(m) = geometric dry mean diameter (m) of the number
692 : ! distribution for aerosol mode m.
693 : ! (Only used when numptr_amode(m) is zero or negative.)
694 : ! dgnumlo_amode(m), dgnumhi_amode(m) = lower and upper limits on the
695 : ! geometric dry mean diameter (m) of the number distribution
696 : ! (Used when mprognum_amode>0, to limit dgnum to reasonable values)
697 : ! sigmag_amode(m) = geometric standard deviation for aerosol mode m
698 : ! sigmaglo_amode(m), sigmaghi_amode(m) = lower and upper limits on the
699 : ! geometric standard deviation of the number distribution
700 : ! (Used when mprogsfc_amode>0, to limit sigmag to reasonable values)
701 : ! alnsg_amode(m) = alog( sigmag_amode(m) )
702 : ! alnsglo_amode(m), alnsghi_amode(m) = alog( sigmaglo/hi_amode(m) )
703 : ! voltonumb_amode(m) = ratio of number to volume for mode m
704 : ! voltonumblo_amode(m), voltonumbhi_amode(m) = ratio of number to volume
705 : ! when dgnum = dgnumlo_amode or dgnumhi_amode, respectively
706 : ! voltosfc_amode(m), voltosfclo_amode(m), voltosfchi_amode(m) - ratio of
707 : ! surface to volume for mode m (like the voltonumb_amode's)
708 : ! alnv2n_amode(m), alnv2nlo_amode(m), alnv2nhi_amode(m) -
709 : ! alnv2n_amode(m) = alog( voltonumblo_amode(m) ), ...
710 : ! alnv2s_amode(m), alnv2slo_amode(m), alnv2shi_amode(m) -
711 : ! alnv2s_amode(m) = alog( voltosfclo_amode(m) ), ...
712 : ! rhcrystal_amode(m) = crystalization r.h. for mode m
713 : ! rhdeliques_amode(m) = deliquescence r.h. for mode m
714 : ! (*** these r.h. values are 0-1 fractions, not 0-100 percentages)
715 : !
716 : ! mcalcwater_amode(m) - if positive, water content for mode m will be
717 : ! calculated and stored in rclm(k,lwaterptr_amode(m)). Otherwise, no.
718 : ! mprognum_amode(m) - if positive, number mixing-ratio for mode m will
719 : ! be prognosed. Otherwise, no.
720 : ! mdiagnum_amode(m) - if positive, number mixing-ratio for mode m will
721 : ! be diagnosed and put into rclm(k,numptr_amode(m)). Otherwise, no.
722 : ! mprogsfc_amode(m) - if positive, surface area mixing-ratio for mode m will
723 : ! be prognosed, and sigmag will vary temporally and spatially.
724 : ! Otherwise, sigmag is constant.
725 : ! *** currently surface area is not prognosed when msectional>0 ***
726 : !
727 : ! ntot_aspectype = overall number of aerosol chemical species defined (over all modes)
728 : ! specdens_amode(l) = dry density (kg/m^3) of aerosol chemical species type l
729 : ! specmw_amode(l) = molecular weight (kg/kmol) of aerosol chemical species type l
730 : ! specname_amode(l) = name of aerosol chemical species type l
731 : ! specrefndxsw(l) = complex refractive index (visible wavelengths)
732 : ! of aerosol chemical species type l
733 : ! specrefndxlw(l) = complex refractive index (infrared wavelengths)
734 : ! of aerosol chemical species type l
735 : ! spechygro(l) = hygroscopicity of aerosol chemical species type l
736 : !
737 : ! lptr_so4_a_amode(m), lptr_so4_cw_amode(m) = gchm r-array index for the
738 : ! mixing ratio for sulfate associated with aerosol mode m
739 : ! ("a" and "cw" phases)
740 : ! (similar for msa, oc, bc, nacl, dust)
741 : !
742 : ! modename_amode(m) = character-variable name for mode m,
743 : ! read from mirage2.inp
744 : ! modeptr_accum - mode index for the main accumulation mode
745 : ! if modeptr_accum = 1, then mode 1 is the main accumulation mode,
746 : ! and modename_amode(1) = "accum"
747 : ! modeptr_aitken - mode index for the main aitken mode
748 : ! if modeptr_aitken = 2, then mode 2 is the main aitken mode,
749 : ! and modename_amode(2) = "aitken"
750 : ! modeptr_ufine - mode index for the ultrafine mode
751 : ! if modeptr_ufine = 3, then mode 3 is the ultrafine mode,
752 : ! and modename_amode(3) = "ufine"
753 : ! modeptr_coarseas - mode index for the coarse sea-salt mode
754 : ! if modeptr_coarseas = 4, then mode 4 is the coarse sea-salt mode,
755 : ! and modename_amode(4) = "coarse_seasalt"
756 : ! modeptr_coardust - mode index for the coarse dust mode
757 : ! if modeptr_coardust = 5, then mode 5 is the coarse dust mode,
758 : ! and modename_amode(5) = "coarse_dust"
759 : !
760 : ! specdens_XX_amode = dry density (kg/m^3) of aerosol chemical species type XX
761 : ! where XX is so4, om, bc, dust, seasalt
762 : ! contains same values as the specdens_amode array
763 : ! allows values to be referenced differently
764 : ! specmw_XX_amode = molecular weight (kg/kmol) of aerosol chemical species type XX
765 : ! contains same values as the specmw_amode array
766 : !
767 : !-----------------------------------------------------------------------
768 :
769 :
770 : !--------------------------------------------------------------
771 : !
772 : ! ... aerosol size information for the current chunk
773 : !
774 : !--------------------------------------------------------------
775 : !
776 : ! dgncur = current geometric mean diameters (cm) for number distributions
777 : ! dgncur_a - for unactivated particles, dry
778 : ! (in physics buffer as DGNUM)
779 : ! dgncur_awet - for unactivated particles, wet at grid-cell ambient RH
780 : ! (in physics buffer as DGNUMWET)
781 : !
782 : ! the dgncur are computed from current mass and number
783 : ! mixing ratios in the grid cell, BUT are then adjusted to be within
784 : ! the bounds defined by dgnumlo/hi_amode
785 : !
786 : ! v2ncur = current (number/volume) ratio based on dgncur and sgcur
787 : ! (volume in cm^3/whatever, number in particles/whatever)
788 : ! == 1.0 / ( pi/6 * dgncur**3 * exp(4.5*((log(sgcur))**2)) )
789 : ! v2ncur_a - for unactivated particles
790 : ! (currently just defined locally)
791 : !
792 :
793 : !==============================================================
794 0 : subroutine search_list_of_names( &
795 0 : name_to_find, name_id, list_of_names, list_length )
796 : !
797 : ! searches for a name in a list of names
798 : !
799 : ! name_to_find - the name to be found in the list [input]
800 : ! name_id - the position of "name_to_find" in the "list_of_names".
801 : ! If the name is not found in the list, then name_id=0. [output]
802 : ! list_of_names - the list of names to be searched [input]
803 : ! list_length - the number of names in the list [input]
804 : !
805 : character(len=*), intent(in):: name_to_find, list_of_names(:)
806 : integer, intent(in) :: list_length
807 : integer, intent(out) :: name_id
808 :
809 : integer :: i
810 0 : name_id = -999888777
811 0 : if (name_to_find .ne. ' ') then
812 0 : do i = 1, list_length
813 0 : if (name_to_find .eq. list_of_names(i)) then
814 0 : name_id = i
815 0 : exit
816 : end if
817 : end do
818 : end if
819 0 : end subroutine search_list_of_names
820 :
821 :
822 : !==============================================================
823 0 : subroutine initaermodes_setspecptrs
824 : !
825 : ! sets the lptr_so4_a_amode(m), lptr_so4_cw_amode(m), ...
826 : ! and writes them to iulog
827 : ! ALSO sets the mode-pointers: modeptr_accum, modeptr_aitken, ...
828 : ! and writes them to iulog
829 : ! ALSO sets values of specdens_XX_amode and specmw_XX_amode
830 : ! (XX = so4, om, bc, dust, seasalt)
831 : !
832 : implicit none
833 :
834 : ! local variables
835 : integer :: i, l, lmassa, lmassc, m
836 : character(len=1000) :: msg
837 : character*8 :: dumname
838 : character*3 :: tmpch3
839 : integer, parameter :: init_val=-999888777
840 : integer :: bc_ndx, soa_ndx, pom_ndx
841 :
842 : ! all processes set the pointers
843 :
844 0 : modeptr_accum = init_val
845 0 : modeptr_aitken = init_val
846 0 : modeptr_ufine = init_val
847 0 : modeptr_coarse = init_val
848 0 : modeptr_pcarbon = init_val
849 0 : modeptr_fineseas = init_val
850 0 : modeptr_finedust = init_val
851 0 : modeptr_coarseas = init_val
852 0 : modeptr_coardust = init_val
853 0 : modeptr_stracoar = init_val
854 :
855 0 : do m = 1, ntot_amode
856 0 : if (modename_amode(m) .eq. 'accum') then
857 0 : modeptr_accum = m
858 0 : else if (modename_amode(m) .eq. 'aitken') then
859 0 : modeptr_aitken = m
860 0 : else if (modename_amode(m) .eq. 'ufine') then
861 0 : modeptr_ufine = m
862 0 : else if (modename_amode(m) .eq. 'coarse') then
863 0 : modeptr_coarse = m
864 0 : else if (modename_amode(m) .eq. 'primary_carbon') then
865 0 : modeptr_pcarbon = m
866 0 : else if (modename_amode(m) .eq. 'fine_seasalt') then
867 0 : modeptr_fineseas = m
868 0 : else if (modename_amode(m) .eq. 'fine_dust') then
869 0 : modeptr_finedust = m
870 0 : else if (modename_amode(m) .eq. 'coarse_seasalt') then
871 0 : modeptr_coarseas = m
872 0 : else if (modename_amode(m) .eq. 'coarse_dust') then
873 0 : modeptr_coardust = m
874 0 : else if (modename_amode(m) .eq. 'coarse_strat') then
875 0 : modeptr_stracoar = m
876 : end if
877 : end do
878 :
879 0 : lptr2_pom_a_amode = init_val
880 0 : lptr2_pom_cw_amode = init_val
881 0 : lptr2_soa_a_amode = init_val
882 0 : lptr2_soa_cw_amode = init_val
883 0 : lptr2_bc_a_amode = init_val
884 0 : lptr2_bc_cw_amode = init_val
885 :
886 0 : do m = 1, ntot_amode
887 :
888 0 : lptr_so4_a_amode(m) = init_val
889 0 : lptr_so4_cw_amode(m) = init_val
890 0 : lptr_msa_a_amode(m) = init_val
891 0 : lptr_msa_cw_amode(m) = init_val
892 0 : lptr_nh4_a_amode(m) = init_val
893 0 : lptr_nh4_cw_amode(m) = init_val
894 0 : lptr_no3_a_amode(m) = init_val
895 0 : lptr_no3_cw_amode(m) = init_val
896 0 : lptr_nacl_a_amode(m) = init_val
897 0 : lptr_nacl_cw_amode(m) = init_val
898 0 : lptr_dust_a_amode(m) = init_val
899 0 : lptr_dust_cw_amode(m) = init_val
900 :
901 0 : pom_ndx = 0
902 0 : soa_ndx = 0
903 0 : bc_ndx = 0
904 :
905 0 : do l = 1, nspec_amode(m)
906 0 : lmassa = lmassptr_amode(l,m)
907 0 : lmassc = lmassptrcw_amode(l,m)
908 :
909 0 : if (lmassa > 0 .and. lmassa <= pcnst) then
910 : write( msg, '(2a,3(1x,i12),2x,a)' ) &
911 0 : 'subr initaermodes_setspecptrs error setting lptr_', &
912 0 : ' - m, l, lmassa, cnst_name = ', m, l, lmassa, cnst_name(lmassa)
913 : else
914 : write( msg, '(2a,3(1x,i12),2x,a)' ) &
915 0 : 'subr initaermodes_setspecptrs error setting lptr_', &
916 0 : ' - m, l, lmassa, cnst_name = ', m, l, lmassa, 'UNDEF '
917 0 : call endrun( trim(msg) )
918 : end if
919 :
920 0 : tmpch3 = cnst_name(lmassa)(:3)
921 0 : select case (tmpch3)
922 : case('so4')
923 0 : lptr_so4_a_amode(m) = lmassa
924 0 : lptr_so4_cw_amode(m) = lmassc
925 : case('msa')
926 0 : lptr_msa_a_amode(m) = lmassa
927 0 : lptr_msa_cw_amode(m) = lmassc
928 : case('nh4')
929 0 : lptr_nh4_a_amode(m) = lmassa
930 0 : lptr_nh4_cw_amode(m) = lmassc
931 : case('no3')
932 0 : lptr_no3_a_amode(m) = lmassa
933 0 : lptr_no3_cw_amode(m) = lmassc
934 : case('dst')
935 0 : lptr_dust_a_amode(m) = lmassa
936 0 : lptr_dust_cw_amode(m) = lmassc
937 : case('ncl')
938 0 : lptr_nacl_a_amode(m) = lmassa
939 0 : lptr_nacl_cw_amode(m) = lmassc
940 : case('pom')
941 0 : pom_ndx = pom_ndx+1
942 0 : lptr2_pom_a_amode(m,pom_ndx) = lmassa
943 0 : lptr2_pom_cw_amode(m,pom_ndx) = lmassc
944 : case('soa')
945 0 : soa_ndx = soa_ndx+1
946 0 : lptr2_soa_a_amode(m,soa_ndx) = lmassa
947 0 : lptr2_soa_cw_amode(m,soa_ndx) = lmassc
948 : case('bc_','bcf','bcb')
949 0 : bc_ndx = bc_ndx+1
950 0 : lptr2_bc_a_amode(m,bc_ndx) = lmassa
951 0 : lptr2_bc_cw_amode(m,bc_ndx) = lmassc
952 : case default
953 0 : call endrun( trim(msg) )
954 : end select
955 : end do ! l
956 : end do ! m
957 :
958 0 : specmw_so4_amode = 1.0_r8
959 :
960 0 : do m = 1, ntot_amode
961 0 : do l = 1, nspec_amode(m)
962 0 : dumname = trim(adjustl(xname_massptr(l,m)))
963 0 : tmpch3 = trim(adjustl(dumname(:3)))
964 0 : if(trim(adjustl(tmpch3)) == 'so4' .or. trim(adjustl(tmpch3)) == 'SO4') then
965 0 : specmw_so4_amode = specmw_amode(l,m)
966 : endif
967 : enddo
968 : enddo
969 :
970 :
971 : ! masterproc writes out the pointers
972 0 : if ( .not. ( masterproc ) ) return
973 :
974 0 : write(iulog,9230)
975 0 : write(iulog,*) 'modeptr_accum =', modeptr_accum
976 0 : write(iulog,*) 'modeptr_aitken =', modeptr_aitken
977 0 : write(iulog,*) 'modeptr_ufine =', modeptr_ufine
978 0 : write(iulog,*) 'modeptr_coarse =', modeptr_coarse
979 0 : write(iulog,*) 'modeptr_pcarbon =', modeptr_pcarbon
980 0 : write(iulog,*) 'modeptr_fineseas =', modeptr_fineseas
981 0 : write(iulog,*) 'modeptr_finedust =', modeptr_finedust
982 0 : write(iulog,*) 'modeptr_coarseas =', modeptr_coarseas
983 0 : write(iulog,*) 'modeptr_coardust =', modeptr_coardust
984 0 : write(iulog,*) 'modeptr_stracoar =', modeptr_stracoar
985 :
986 0 : dumname = 'none'
987 0 : write(iulog,9240)
988 0 : write(iulog,9000) 'sulfate '
989 0 : do m = 1, ntot_amode
990 : call initaermodes_setspecptrs_write2( m, &
991 0 : lptr_so4_a_amode(m), lptr_so4_cw_amode(m), 'so4' )
992 : end do
993 :
994 0 : write(iulog,9000) 'msa '
995 0 : do m = 1, ntot_amode
996 : call initaermodes_setspecptrs_write2( m, &
997 0 : lptr_msa_a_amode(m), lptr_msa_cw_amode(m), 'msa' )
998 : end do
999 :
1000 0 : write(iulog,9000) 'ammonium '
1001 0 : do m = 1, ntot_amode
1002 : call initaermodes_setspecptrs_write2( m, &
1003 0 : lptr_nh4_a_amode(m), lptr_nh4_cw_amode(m), 'nh4' )
1004 : end do
1005 :
1006 0 : write(iulog,9000) 'nitrate '
1007 0 : do m = 1, ntot_amode
1008 : call initaermodes_setspecptrs_write2( m, &
1009 0 : lptr_no3_a_amode(m), lptr_no3_cw_amode(m), 'no3' )
1010 : end do
1011 :
1012 0 : write(iulog,9000) 'p-organic '
1013 0 : do m = 1, ntot_amode
1014 0 : do i = 1, npoa
1015 0 : write(dumname,'(a,i2.2)') 'pom', i
1016 : call initaermodes_setspecptrs_write2b( m, &
1017 0 : lptr2_pom_a_amode(m,i), lptr2_pom_cw_amode(m,i), dumname(1:5) )
1018 : end do
1019 : end do
1020 :
1021 0 : write(iulog,9000) 's-organic '
1022 0 : do m = 1, ntot_amode
1023 0 : do i = 1, nsoa
1024 0 : write(dumname,'(a,i2.2)') 'soa', i
1025 : call initaermodes_setspecptrs_write2b( m, &
1026 0 : lptr2_soa_a_amode(m,i), lptr2_soa_cw_amode(m,i), dumname(1:5) )
1027 : end do
1028 : end do
1029 0 : do i = 1, nsoa
1030 0 : l = lptr2_soa_g_amode(i)
1031 0 : write(iulog,'(i4,2x,i12,2x,a,20x,a,i2.2,a)') i, l, cnst_name(l), 'lptr2_soa', i, '_g'
1032 : end do
1033 :
1034 0 : write(iulog,9000) 'black-c '
1035 0 : do m = 1, ntot_amode
1036 0 : do i = 1, nbc
1037 0 : write(dumname,'(a,i2.2)') 'bc', i
1038 : call initaermodes_setspecptrs_write2b( m, &
1039 0 : lptr2_bc_a_amode(m,i), lptr2_bc_cw_amode(m,i), dumname(1:5) )
1040 : end do
1041 : end do
1042 :
1043 0 : write(iulog,9000) 'seasalt '
1044 0 : do m = 1, ntot_amode
1045 : call initaermodes_setspecptrs_write2( m, &
1046 0 : lptr_nacl_a_amode(m), lptr_nacl_cw_amode(m), 'nacl' )
1047 : end do
1048 :
1049 0 : write(iulog,9000) 'dust '
1050 0 : do m = 1, ntot_amode
1051 : call initaermodes_setspecptrs_write2( m, &
1052 0 : lptr_dust_a_amode(m), lptr_dust_cw_amode(m), 'dust' )
1053 : end do
1054 :
1055 : 9000 format( a )
1056 : 9230 format( &
1057 : / 'mode-pointer output from subr initaermodes_setspecptrs' )
1058 : 9240 format( &
1059 : / 'species-pointer output from subr initaermodes_setspecptrs' / &
1060 : 'mode', 12x, 'id name_a ', 12x, 'id name_cw' )
1061 :
1062 : return
1063 : end subroutine initaermodes_setspecptrs
1064 :
1065 :
1066 : !==============================================================
1067 0 : subroutine initaermodes_setspecptrs_write2( &
1068 : m, laptr, lcptr, txtdum )
1069 : !
1070 : ! does some output for initaermodes_setspecptrs
1071 :
1072 : use constituents, only: pcnst, cnst_name
1073 :
1074 : implicit none
1075 :
1076 : ! subr arguments
1077 : integer, intent(in) :: m, laptr, lcptr
1078 : character*(*), intent(in) :: txtdum
1079 :
1080 : ! local variables
1081 : character*8 dumnamea, dumnamec
1082 :
1083 0 : dumnamea = 'none'
1084 0 : dumnamec = 'none'
1085 0 : if (laptr > pcnst .or. lcptr > pcnst ) then
1086 0 : call endrun('initaermodes_setspecptrs_write2: ERROR')
1087 : endif
1088 0 : if (laptr .gt. 0) dumnamea = cnst_name(laptr)
1089 0 : if (lcptr .gt. 0) dumnamec = cnst_name(lcptr)
1090 0 : write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum
1091 :
1092 : 9241 format( i4, 2( 2x, i12, 2x, a ), &
1093 : 4x, 'lptr_', a, '_a/cw_amode' )
1094 :
1095 0 : return
1096 : end subroutine initaermodes_setspecptrs_write2
1097 :
1098 :
1099 : !==============================================================
1100 0 : subroutine initaermodes_setspecptrs_write2b( &
1101 : m, laptr, lcptr, txtdum )
1102 : !
1103 : ! does some output for initaermodes_setspecptrs
1104 :
1105 : implicit none
1106 :
1107 : ! subr arguments
1108 : integer, intent(in) :: m, laptr, lcptr
1109 : character*(*), intent(in) :: txtdum
1110 :
1111 : ! local variables
1112 : character*8 dumnamea, dumnamec
1113 :
1114 0 : dumnamea = 'none'
1115 0 : dumnamec = 'none'
1116 0 : if (laptr .gt. 0) dumnamea = cnst_name(laptr)
1117 0 : if (lcptr .gt. 0) dumnamec = cnst_name(lcptr)
1118 0 : write(iulog,9241) m, laptr, dumnamea, lcptr, dumnamec, txtdum
1119 :
1120 : 9241 format( i4, 2( 2x, i12, 2x, a ), &
1121 : 4x, 'lptr2_', a, '_a/cw_amode' )
1122 :
1123 0 : return
1124 : end subroutine initaermodes_setspecptrs_write2b
1125 :
1126 : !==============================================================
1127 0 : subroutine initaermodes_set_cnstnamecw
1128 : !
1129 : ! sets the cnst_name_cw
1130 : !
1131 : use constituents, only: pcnst, cnst_name
1132 : implicit none
1133 :
1134 : ! subr arguments (none)
1135 :
1136 : ! local variables
1137 : integer j, l, la, lc, ll, m
1138 :
1139 : ! set cnst_name_cw
1140 0 : cnst_name_cw = ' '
1141 0 : do m = 1, ntot_amode
1142 0 : do ll = 0, nspec_amode(m)
1143 0 : if (ll == 0) then
1144 0 : la = numptr_amode(m)
1145 0 : lc = numptrcw_amode(m)
1146 : else
1147 0 : la = lmassptr_amode(ll,m)
1148 0 : lc = lmassptrcw_amode(ll,m)
1149 : end if
1150 : if ((la < 1) .or. (la > pcnst) .or. &
1151 0 : (lc < 1) .or. (lc > pcnst)) then
1152 : write(*,'(/2a/a,5(1x,i10))') &
1153 0 : '*** initaermodes_set_cnstnamecw error', &
1154 0 : ' -- bad la or lc', &
1155 0 : ' m, ll, la, lc, pcnst =', m, ll, la, lc, pcnst
1156 0 : call endrun( '*** initaermodes_set_cnstnamecw error' )
1157 : end if
1158 0 : do j = 2, len( cnst_name(la) ) - 1
1159 0 : if (cnst_name(la)(j:j+1) == '_a') then
1160 0 : cnst_name_cw(lc) = cnst_name(la)
1161 0 : cnst_name_cw(lc)(j:j+1) = '_c'
1162 0 : exit
1163 0 : else if (cnst_name(la)(j:j+1) == '_A') then
1164 0 : cnst_name_cw(lc) = cnst_name(la)
1165 0 : cnst_name_cw(lc)(j:j+1) = '_C'
1166 0 : exit
1167 : end if
1168 : end do
1169 0 : if (cnst_name_cw(lc) == ' ') then
1170 : write(*,'(/2a/a,3(1x,i10),2x,a)') &
1171 0 : '*** initaermodes_set_cnstnamecw error', &
1172 0 : ' -- bad cnst_name(la)', &
1173 0 : ' m, ll, la, cnst_name(la) =', &
1174 0 : m, ll, la, cnst_name(la)
1175 0 : call endrun( '*** initaermodes_set_cnstnamecw error' )
1176 : end if
1177 : end do ! ll = 0, nspec_amode(m)
1178 : end do ! m = 1, ntot_amode
1179 :
1180 0 : if ( masterproc ) then
1181 0 : write(*,'(/a)') 'l, cnst_name(l), cnst_name_cw(l)'
1182 0 : do l = 1, pcnst
1183 0 : write(*,'(i4,2(2x,a))') l, cnst_name(l), cnst_name_cw(l)
1184 : end do
1185 : end if
1186 :
1187 0 : return
1188 : end subroutine initaermodes_set_cnstnamecw
1189 :
1190 : end module modal_aero_data
|
