| blob | 84d78bbd5ea0dcdb0282efb1bf35c36afe422736 |
1 ! module_cam_mam_aerchem_driver.F
2 ! created by r.c.easter, june 2010
3 !
4 ! 2010-07-03 notes:
5 !
6 !--------------------------------------------------------------
8 module module_cam_mam_aerchem_driver
10 private
11 public :: cam_mam_aerchem_driver
13 contains
16 !==============================================================
17 subroutine cam_mam_aerchem_driver( &
18 id, curr_secs, ktau, dtstep, ktauc, dtstepc, config_flags, &
19 t_phy, rho_phy, p_phy, p8w, alt, z, z_at_w, pbl_h, cldfra, &
20 cldfra_mp_all, moist, chem, &
21 dgnum, dgnumwet, wetdens_ap, del_h2so4_gasprod, &
22 dvmrdt_sv13d, dvmrcwdt_sv13d, & !Output from cloud chemistry
23 is_CAMMGMP_used, &!BSINGH:01/31/2013: Added is_CAMMGMP_used
24 ids,ide, jds,jde, kds,kde, &
25 ims,ime, jms,jme, kms,kme, &
26 its,ite, jts,jte, kts,kte )
27 !-----------------------------------------------------------------------
28 ! DESCRIPTION
29 !
30 ! cam_mam_aerchem_driver is the interface between wrf-chem and the
31 ! cam_mam aerosol-chemistry routine cat computes condensation/evaporation
32 ! of trace gases to/from aerosol particles (AP). It currently treats
33 ! water vapor and the 4 inorganic trace gases (nh3, h2so4, hno3, and hcl).
34 ! The aerosol-chemistry routine can work with either a sectional
35 ! (multiple size bins) or modal (multiple modes) representation.
36 !
37 ! In both cases, condensation/evaporation to/from each bins/mode is
38 ! first computed. For sectional representation, AP mass and number
39 ! are then transferred between size bins as a result of AP
40 ! positive/negative growth. Either a moving-center or two-moment
41 ! algorithm can be used to compute this transfer.
42 !
43 ! cam_mam_aerchem_driver is organized as follows
44 ! loop over j and i
45 ! call aerchemistry to do the aerosol chemistry calculations
46 ! for timestep = dtstepc
47 !
48 !-----------------------------------------------------------------------
50 use module_configure, only: &
51 grid_config_rec_type, &
52 p_qv
54 use module_state_description, only: num_moist, num_chem, &
55 param_first_scalar
57 use shr_kind_mod, only: r8 => shr_kind_r8
58 use module_cam_support, only: pcols, pver, pverp, &
59 pcnst => pcnst_runtime, &
60 pcnst_non_chem => pcnst_non_chem_modal_aero, &
61 gas_pcnst => gas_pcnst_modal_aero, &
62 gas_pcnst_pos => gas_pcnst_modal_aero_pos, &
63 endrun
64 use constituents, only: cnst_name, cnst_get_ind
65 use physconst, only: mwdry, pi
67 use modal_aero_calcsize, only: modal_aero_calcsize_sub
68 use modal_aero_coag, only: modal_aero_coag_sub
69 use modal_aero_gasaerexch , only: modal_aero_gasaerexch_sub
70 use modal_aero_newnuc, only: modal_aero_newnuc_sub
71 use modal_aero_wateruptake, only: modal_aero_wateruptake_sub
73 use modal_aero_data, only: &
74 alnsg_amode, dgnum_amode, dgnumlo_amode, dgnumhi_amode, &
75 lmassptr_amode, lspectype_amode, &
76 lptr_nacl_a_amode, lptr_so4_a_amode, lptr_soa_a_amode, &
77 ntot_amode, nspec_amode, ntot_amode, numptr_amode, &
78 specdens_amode, spechygro
80 use module_data_cam_mam_asect, only: &
81 ai_phase, &
82 factconv_chem_to_q, factconv_chem_to_qqcw, &
83 lptr_chem_to_q, lptr_chem_to_qqcw, &
84 massptr_aer, mw_q_array, mw_q_mo_array, &
85 nsize_aer, ntype_aer, numptr_aer, waterptr_aer
87 implicit none
89 ! subr arguments
90 type(grid_config_rec_type), intent(in) :: config_flags
91 ! config_flags - configuration and control parameters
92 logical, intent(in) :: is_CAMMGMP_used
93 integer, intent(in) :: &
94 id, ktau, ktauc, &
95 ids, ide, jds, jde, kds, kde, &
96 ims, ime, jms, jme, kms, kme, &
97 its, ite, jts, jte, kts, kte
98 ! id - domain index
99 ! ktau - time step number
100 ! ktauc - gas and aerosol chemistry time step number
102 ! [ids:ide, kds:kde, jds:jde] - spatial (x,z,y) indices for "domain"
103 ! [ims:ime, kms:kme, jms:jme] - spatial (x,z,y) indices for "memory"
104 ! Most arrays that are arguments to chem_driver
105 ! are dimensioned with these spatial indices.
106 ! [its:ite, kts:kte, jts:jte] - spatial (x,z,y) indices for "tile"
107 ! chem_driver and routines under it do calculations
108 ! over these spatial indices.
110 real(kind=8), intent(in) :: curr_secs
111 real, intent(in) :: dtstep, dtstepc
112 ! dtstep - main model time step (s)
113 ! dtstepc - time step for gas and aerosol chemistry(s)
115 real, intent(in), &
116 dimension( ims:ime, kms:kme, jms:jme ) :: &
117 t_phy, rho_phy, p_phy, p8w, alt, &
118 z, z_at_w, cldfra, cldfra_mp_all
119 ! t_phy - temperature at layer center (K)
120 ! rho_phy - air density at layer center (kg/m^3)
121 ! p_phy - air pressure at layer center (Pa)
122 ! p8w - air pressure at layer interfaces (Pa)
123 ! alt - dry air specific volume at layer center (m^3/kg)
124 ! z - height at layer center (m msl)
125 ! z_at_w - height at layer interfaces (m msl)
126 ! cldfra - cloud fraction of layer (--)
127 ! cldfra_mp_all- cloud fraction from CAMMGMP
129 real, intent(in), &
130 dimension( ims:ime, jms:jme ) :: &
131 pbl_h
132 ! pbl_h - pbl height (m agl)
134 real, intent(in), &
135 dimension( ims:ime, kms:kme, jms:jme, 1:num_moist ) :: &
136 moist
137 ! moist - mixing ratios of moisture species (water vapor,
138 ! cloud water, ...) (kg/kg for mass species, #/kg for number species)
140 real, intent(inout), &
141 dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
142 chem
143 ! chem - mixing ratios of trace gase (ppm) and aerosol species
144 ! (ug/kg for mass species, #/kg for number species)
146 real, intent(inout), &
147 dimension( ims:ime, kms:kme, jms:jme, ntot_amode ) :: &
148 dgnum, dgnumwet, wetdens_ap
149 ! dgnum - median dry-diameter of number distribution for mode (m)
150 ! dgnumwet - median wet-diameter of number distribution for mode (m)
151 ! wetdens_ap - wet density of mode (kg/m^3)
152 real, intent(in), &
153 dimension( ims:ime, kms:kme, jms:jme ) :: &
154 del_h2so4_gasprod
155 ! del_h2so4_gasprod - h2so4 change from gas-phase chemistry (ppmv)
157 !
158 !tendencies:dvmrdt_sv13d,dvmrcwdt_sv13d are the tendencies which are passsed on from the CAM-MAM cloud chemistry
159 ! to gasaerexch subroutine
160 !
161 real, intent(in), dimension( ims:ime, kms:kme, jms:jme, 1:gas_pcnst_pos ) :: dvmrdt_sv13d,dvmrcwdt_sv13d
163 !-----------------------------------------------------------------------
164 ! local variables
165 integer :: aerchem_onoffb, aercoag_onoffb, aernewnuc_onoffb
166 integer, parameter :: debug_level=0
167 integer, parameter :: icol = 1
168 integer, parameter :: idiag_calcsize=0, idiag_wateruptake=0
169 integer, parameter :: idiag_gasaerexch=0, idiag_newnuc=0, idiag_coag=0
170 integer :: i, icalcaer_flag, istat, itmpa, iwaterup_flag
171 integer :: idiagaa, idiagaa_idel, idiagaa_jdel
172 integer :: imozart, imozart_m1
173 integer :: j
174 integer :: k, kcam
175 integer :: l, l1, l2, l3, lchnk, loffset
176 integer :: l_mo_h2so4, l_mo_soag
177 integer :: latndx(pcols), lonndx(pcols)
178 integer :: n, ncol, nstep
179 integer :: p1st
181 real(r8) :: cld8(pcols,pver)
182 real(r8) :: deltat8
183 real(r8) :: del_h2so4_gasprod8(pcols,pver)
184 real(r8) :: del_h2so4_aeruptk8(pcols,pver)
185 real(r8) :: dgnum8(pcols,pver,ntot_amode)
186 real(r8) :: dgnumwet8(pcols,pver,ntot_amode)
187 real(r8) :: dqdt8(pcols,pver,pcnst)
188 real(r8) :: dvmrdt_sv18(pcols,pver,gas_pcnst_pos), &
189 dvmrcwdt_sv18(pcols,pver,gas_pcnst_pos)
190 real(r8) :: fconv
191 real(r8) :: pblh8(pcols)
192 real(r8) :: pdel8(pcols,pver), pmid8(pcols,pver)
193 real(r8) :: qaerwat8(pcols,pver,ntot_amode)
194 real(r8) :: q8(pcols,pver,pcnst), qqcw8(pcols,pver,pcnst)
195 real(r8) :: qv8(pcols,pver)
196 real(r8) :: rh8(pcols,pver)
197 real(r8) :: tmpa, tmpb
198 real(r8) :: tmpveca(gas_pcnst), tmpvecb(gas_pcnst)
199 real(r8) :: tmpvmra(pver,gas_pcnst)
200 real(r8) :: tmp_dgnum(ntot_amode), tmp_dstar(ntot_amode)
201 real(r8) :: tmp_hygro(pver,ntot_amode)
202 real(r8) :: tmp_num(ntot_amode), tmp_vdry(ntot_amode)
203 real(r8) :: t8(pcols,pver)
204 real(r8) :: vmr8(pcols,pver,gas_pcnst), vmrcw8(pcols,pver,gas_pcnst)
205 real(r8) :: wetdens_ap8(pcols,pver,ntot_amode)
206 real(r8) :: zm8(pcols,pver)
208 logical :: aero_mmr_flag
209 logical :: dotend(pcnst)
210 logical :: h2o_mmr_flag
212 character*100 msg
215 itmpa = config_flags%aerchem_onoff
216 if (itmpa <= 0) return
218 aerchem_onoffb = 1
219 aercoag_onoffb = 1
220 aernewnuc_onoffb = 1
221 if (itmpa == 99) then
222 aerchem_onoffb = 0
223 else if (itmpa >= 100) then
224 aerchem_onoffb = mod(itmpa/100,10) ! 100s digit
225 aernewnuc_onoffb = mod(itmpa/10, 10) ! 10s digit
226 aercoag_onoffb = mod(itmpa, 10) ! 1s digit
227 end if
228 if (aerchem_onoffb <= 0) then
229 aercoag_onoffb = 0
230 aernewnuc_onoffb = 0
231 end if
233 write(*,'(/a,3i5)') 'cam_mam_aerchem_driver - id, ktau, ktauc =', id, ktau, ktauc
234 write(*,'(a,3(4x,2i5))') 'ids/e, j..., k... ', ids,ide, jds,jde, kds,kde
235 write(*,'(a,3(4x,2i5))') 'ims/e, j..., k... ', ims,ime, jms,jme, kms,kme
236 write(*,'(a,3(4x,2i5))') 'its/e, j..., k... ', its,ite, jts,jte, kts,kte
237 write(*,'(a,3i10 )') 'pver, pverp, pcols ', pver, pverp, pcols
238 write(*,'(a,3i10 )') 'aerchem/newnuc/coag_onoffb', &
239 aerchem_onoffb, aernewnuc_onoffb, aercoag_onoffb
242 p1st = param_first_scalar
243 imozart_m1 = pcnst_non_chem
244 imozart = imozart_m1 + 1
246 call cnst_get_ind( 'h2so4', l_mo_h2so4, .false. )
247 l_mo_h2so4 = l_mo_h2so4 - imozart_m1
248 if ((l_mo_h2so4 < 1) .or. (l_mo_h2so4 > gas_pcnst)) &
249 call endrun( &
250 'cam_mam_aerchem_driver error -- no h2so4 species' )
251 write(*,*) 'l_mo_h2so4 = ', l_mo_h2so4
253 call cnst_get_ind( 'soag', l_mo_soag, .false. )
254 l_mo_soag = l_mo_soag - imozart_m1
255 if ((l_mo_soag < 1) .or. (l_mo_soag > gas_pcnst)) &
256 call endrun( &
257 'cam_mam_aerchem_driver error -- no soag species' )
258 write(*,*) 'l_mo_soag = ', l_mo_soag
262 !--------------------------------------------------------------------
263 !
264 ! Main loop over the points in the tile and treat them each as a CAM chunk
265 !
266 !--------------------------------------------------------------------
267 do 2920 j = jts, jte
268 ! write( msg, '(a,3i5)' ) 'cam_mam_aerchem_driver 2920 loop - j =', j
269 ! call wrf_debug( 100, msg )
270 do 2910 i = its, ite
272 lchnk = (j-jts)*(ite-its+1) + (i-its+1) !1-D index location from the 2-D tile
273 ncol = 1
275 latndx(icol) = j
276 lonndx(icol) = i
278 ! initialize these arrays to zero
279 q8(:,:,:) = 0.0_r8
280 qqcw8(:,:,:) = 0.0_r8
281 qaerwat8(:,:,:) = 0.0_r8
283 dgnum8(:,:,:) = 0.0_r8
284 dgnumwet8(:,:,:) = 0.0_r8
285 wetdens_ap8(:,:,:) = 0.0_r8
287 ! pblh8 is msl, pbl_h is agl
288 pblh8(icol) = pbl_h(i,j) + z_at_w(i,kts,j)
289 ! force it to be at least the top of lowest layer
290 pblh8(icol) = max( pblh8(icol), 1.0_r8*z_at_w(i,kts+1,j) )
292 ! load the cam layer-center variables
293 ! (reverse the vertical index, and convert units as needed)
294 do k = kts, kte
295 kcam = kte-k+1
297 ! cld8(icol,kcam) = cldfra(i,k,j)
298 ! qh8(icol,kcam,1) = max( qv(i,k,j)/(1.+qv(i,k,j)), 1e-30 ) !values of 0 cause a crash in entropy
299 ! if( present(qc) ) then
300 ! ql8(icol,kcam) = qc(i,k,j)/(1.+qv(i,k,j)) !Convert to moist mix ratio
301 ! else
302 ! ql8(icol,kcam) = 0.
303 ! end if
304 ! if( present(qi) ) then
305 ! qi8(icol,kcam) = qi(i,k,j)/(1.+qv(i,k,j)) !Used in convtran, ditto for conversion
306 ! else
307 ! qi8(icol,kcam) = 0.
308 ! end if
309 ! zm8(icol,kcam) = z(i,k,j)
311 t8(icol,kcam) = t_phy(i,k,j)
312 pdel8(icol,kcam) = p8w(i,k,j) - p8w(i,k+1,j)
313 pmid8(icol,kcam) = p_phy(i,k,j)
314 zm8(icol,kcam) = z(i,k,j)
315 if(is_CAMMGMP_used) then
316 cld8(icol,kcam) = cldfra_mp_all(i,k,j)
317 else
318 cld8(icol,kcam) = cldfra(i,k,j)
319 endif
321 ! cld8(icol,kcam) = 0.0 ! *** temporary
323 qv8(icol,kcam) = moist(i,k,j,p_qv)/(1.+moist(i,k,j,p_qv)) ! convert from dry to moist mix ratio
325 do n = 1, ntype_aer
326 dgnum8(icol,kcam,n) = dgnum(i,k,j,n)
327 dgnumwet8(icol,kcam,n) = dgnumwet(i,k,j,n)
328 wetdens_ap8(icol,kcam,n) = wetdens_ap(i,k,j,n)
330 l = waterptr_aer(1,n)
331 if ((l >= p1st) .and. (l <= num_chem)) &
332 qaerwat8(icol,kcam,n) = chem(i,k,j,l)*factconv_chem_to_q(l)
333 end do ! n
335 do l = p1st, num_chem
336 l2 = lptr_chem_to_q(l)
337 if ((l2 >= 1) .and. (l2 <= pcnst)) then
338 q8(icol,kcam,l2) = chem(i,k,j,l)*factconv_chem_to_q(l)
339 end if
340 if (i*j==1 .and. k==kts .and. l2==l_mo_h2so4+pcnst_non_chem) &
341 write(*,'(a,1p,2e11.3)') '1,1,1 h2so4 chem & q8', &
342 chem(i,k,j,l), q8(icol,kcam,l2)
343 if (i*j==1 .and. k==kts .and. l2==l_mo_soag+pcnst_non_chem) &
344 write(*,'(a,1p,2e11.3)') '1,1,1 soag chem & q8', &
345 chem(i,k,j,l), q8(icol,kcam,l2)
346 ! cycle ! this is temporary
348 l2 = lptr_chem_to_qqcw(l)
349 if ((l2 >= 1) .and. (l2 <= pcnst)) then
350 qqcw8(icol,kcam,l2) = chem(i,k,j,l)*factconv_chem_to_q(l)
351 end if
352 end do ! l
354 del_h2so4_gasprod8(icol,kcam) = del_h2so4_gasprod(i,k,j)
355 if(config_flags%cldchem_onoff == 1 .and. config_flags%chem_opt >= 501 .AND. config_flags%chem_opt <= 504) then
356 do l = 1 , gas_pcnst
357 dvmrdt_sv18(1,kcam,l) = dvmrdt_sv13d(i,k,j,l)
358 dvmrcwdt_sv18(1,kcam,l) = dvmrcwdt_sv13d(i,k,j,l)
359 enddo
360 else
361 dvmrdt_sv18(1,kcam,:) = 0.0_r8
362 dvmrcwdt_sv18(1,kcam,:) = 0.0_r8
363 endif
364 end do ! k
366 ! load the cam layer-interface variables
367 ! (reverse the vertical index, and convert units as needed)
368 do k = kts, kte+1
369 kcam = kte-k+2
371 ! pint8(icol,kcam) = p8w(i,k,j)
372 ! zi8(icol,kcam) = z_at_w(i,k,j)
373 end do
377 !--------------------------------------------------------------------
378 !
379 ! do modal_aero_calcsize_sub
380 !
381 !--------------------------------------------------------------------
382 idiagaa = 1 ; idiagaa_idel = 100 ; idiagaa_jdel = 100
384 nstep = ktau
385 icalcaer_flag = 1
386 loffset = 0 ! using entire q array, not the mozart "chem subset"
387 aero_mmr_flag = .true. ! q values are mass mixing ratios (kg/kg)
389 deltat8 = dtstepc
391 dotend(:) = .false.
392 dqdt8(:,:,:) = 0.0_r8
394 ! diagnostics for initial testing
395 if (idiag_calcsize > 0) then
396 if ((i==its) .and. (j==jts)) then
397 ! deltat8 = 86400.0*0.1 ! for testing, use bigger step size to see bigger changes
398 do kcam = kts, kte, (kte-kts)
399 k = kte-kcam+1
400 tmp_num(1:ntot_amode) = q8(icol,kcam,numptr_amode(1:ntot_amode))
401 ! adjust number mixrat here for testing
402 ! q8(icol,k,numptr_amode(1)) = q8(icol,k,numptr_amode(1)) * 1.0_r8
403 ! q8(icol,k,numptr_amode(2)) = q8(icol,k,numptr_amode(2)) / 8.0_r8
404 ! q8(icol,k,numptr_amode(3)) = q8(icol,k,numptr_amode(3)) * 8.0_r8
405 do n = 1, ntot_amode
406 ! calc dry volume
407 tmp_vdry(n) = 0.0
408 tmp_hygro(kcam,n) = 0.0
409 do l1 = 1, nspec_amode(n)
410 l2 = lmassptr_amode(l1,n)
411 l3 = lspectype_amode(l1,n)
412 tmpa = q8(icol,kcam,l2)/specdens_amode(l3)
413 tmp_vdry(n) = tmp_vdry(n) + tmpa
414 tmp_hygro(kcam,n) = tmp_hygro(kcam,n) + tmpa*spechygro(l3)
415 end do
416 tmp_hygro(kcam,n) = tmp_hygro(kcam,n)/max(tmp_vdry(n),1.0e-35_r8)
417 ! calc volume mean and number median diameter
418 tmpa = tmp_vdry(n)*6.0/( pi*q8(icol,kcam,numptr_amode(n)) )
419 tmp_dstar(n) = tmpa**(1.0/3.0)
420 tmpb = alnsg_amode(n)
421 tmp_dgnum(n) = tmp_dstar(n) * exp(-1.5*tmpb*tmpb)
422 end do
424 write(*,'(/a,4i5,1p,e12.4)') &
425 'calcsize diagnostics before, i, j, k, kcam, deltat =', &
426 i, j, k, kcam, deltat8
427 write(*,'(a,1p,7e12.4))') 'tmp_vdry ', &
428 ( tmp_vdry(n), n=1,ntot_amode )
429 write(*,'(a,1p,7e12.4))') 'tmp_dstar ', &
430 ( tmp_dstar(n), n=1,ntot_amode )
431 write(*,'(a,1p,7e12.4))') 'tmp_dgnum ', &
432 ( tmp_dgnum(n), n=1,ntot_amode )
433 write(*,'(a,1p,7e12.4))') 'dgnumlo ', &
434 ( dgnumlo_amode(n), n=1,ntot_amode )
435 write(*,'(a,1p,7e12.4))') 'dgnumhi ', &
436 ( dgnumhi_amode(n), n=1,ntot_amode )
437 write(*,'(a,1p,7e12.4))') 'dgnum ', &
438 ( dgnum8(icol,kcam,n), n=1,ntot_amode )
439 write(*,'(a,1p,7e12.4))') 'number ', &
440 ( q8(icol,kcam,numptr_amode(n)), n=1,ntot_amode )
441 write(*,'(a,1p,7e12.4))') 'tmp_num ', &
442 ( tmp_num(n), n=1,ntot_amode )
443 write(*,'(a,1p,7e12.4))') 'q '
444 write(*,'(5(2x,a,1p,e12.4))') ( cnst_name(l)(1:6), &
445 q8(icol,kcam,l), l=lmassptr_amode(1,1), pcnst )
446 end do
447 end if
448 end if !(idiag_calcsize > 0)
450 if (idiagaa > 0) then
451 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
452 print 93010, 'calling modal_aero_calcsize_sub - i,j =', i, j
453 end if
455 !
456 ! this is the call done in cam
457 ! call modal_aero_calcsize_sub( &
458 ! lchnk, ncol, nstep, &
459 ! 1, 0, &
460 ! .true., dt, &
461 ! state%t, state%pmid, &
462 ! state%pdel, state%q, &
463 ! ptend%q, ptend%lq, &
464 ! qqcw, dgnum_pbuf )
465 !
466 ! this is the subr in wrfchem
467 ! subr------ modal_aero_calcsize_sub( &
468 ! lchnk, ncol, nstep, icalcaer_flag, &
469 ! loffset, &
470 ! aero_mmr_flag, deltat, &
471 ! t, pmid, pdel, q, &
472 ! dqdt, dotend, qqcw, dgncur_a )
473 !
474 call modal_aero_calcsize_sub( &
475 lchnk, ncol, nstep, icalcaer_flag, &
476 loffset, &
477 aero_mmr_flag, deltat8, &
478 t8, pmid8, pdel8, q8, &
479 dqdt8, dotend, qqcw8, dgnum8 )
481 if (idiagaa > 0) then
482 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
483 print 93010, 'backfrm modal_aero_calcsize_sub - i,j =', i, j
484 end if
486 ! diagnostics for initial testing
487 if (idiag_calcsize > 0) then
488 if ((i==its) .and. (j==jts)) then
489 do kcam = kts, kte, (kte-kts)
490 k = kte-kcam+1
491 write(*,'(/a,4i5)') &
492 'calcsize diagnostics after , i, j, k, kcam =', i, j, k, kcam
493 write(*,'(a,1p,7e12.4))') 'dgnum ', &
494 ( dgnum8(icol,kcam,n), n=1,ntot_amode )
495 write(*,'(a,1p,7e12.4))') 'number ', &
496 ( q8(icol,kcam,numptr_amode(n)), n=1,ntot_amode )
497 write(*,'(a,1p,7e12.4))') ' +dt*tend ', &
498 ( q8(icol,kcam,numptr_amode(n))+ &
499 deltat8*dqdt8(icol,kcam,numptr_amode(n)), n=1,ntot_amode )
500 write(*,'(a,1p,7e12.4))') 'q+dt*tend '
501 write(*,'(5(2x,a,1p,e12.4))') ( cnst_name(l)(1:6), &
502 q8(icol,kcam,l)+deltat8*dqdt8(icol,kcam,l), l=lmassptr_amode(1,1), pcnst )
503 end do
504 write(*,'(a)')
505 end if
506 end if !(idiag_calcsize > 0)
508 ! apply tendencies
509 do l = 1, pcnst
510 if ( .not. dotend(l) ) cycle
511 do k = 1, pver
512 q8(icol,k,l) = q8(icol,k,l) + deltat8*dqdt8(icol,k,l)
513 q8(icol,k,l) = max( q8(icol,k,l), 0.0_r8 )
514 end do
515 end do
519 !--------------------------------------------------------------------
520 !
521 ! do modal_aero_wateruptake_sub
522 !
523 !--------------------------------------------------------------------
524 #ifdef OBSRH
525 ! the modal_aero_wateruptake_sub OBSRH option is not implemented in wrf-chem
526 msg = 'cam_mam_aerchem_driver calling modal_aero_wateruptake_sub' // &
527 ' -- cannot do OBSRH'
528 call wrf_error_fatal( msg )
529 #endif
531 iwaterup_flag = 1
532 h2o_mmr_flag = .true.
534 dotend(:) = .false.
535 dqdt8(:,:,:) = 0.0_r8
536 rh8(:,:) = 0.0_r8
538 ! diagnostics for initial testing
539 if (idiag_wateruptake > 0) then
540 if ((i==its) .and. (j==jts)) then
541 do kcam = kts, kte, (kte-kts)
542 ! qv8(icol,kcam) = qv8(icol,kcam)*2.0 ! for testing
543 k = kte-kcam+1
544 write(*,'(/a,4i5,1p,e12.4)') &
545 'wateruptake diagnostics before, i, j, k, kcam, deltat =', &
546 i, j, k, kcam, deltat8
547 write(*,'(a,1p,7e12.4))') 'tmp_hygro ', &
548 ( tmp_hygro(kcam,n), n=1,ntot_amode )
549 write(*,'(a,1p,7e12.4))') 'qaerwat ', &
550 ( qaerwat8(icol,kcam,n), n=1,ntot_amode )
551 write(*,'(a,1p,7e12.4))') 'dgnum ', &
552 ( dgnum8(icol,kcam,n), n=1,ntot_amode )
553 write(*,'(a,1p,7e12.4))') 'dgnumwet ', &
554 ( dgnumwet8(icol,kcam,n), n=1,ntot_amode )
555 write(*,'(a,1p,7e12.4))') 'wetdens_ap', &
556 ( wetdens_ap8(icol,kcam,n), n=1,ntot_amode )
557 end do
558 end if
559 end if ! (idiag_wateruptake > 0)
561 if (idiagaa > 0) then
562 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
563 print 93010, 'calling modal_aero_wateruptake_sub - i,j =', i, j
564 end if
566 !
567 ! this is the call done in cam
568 ! call modal_aero_wateruptake_sub( &
569 ! lchnk, ncol, nstep, &
570 ! 1, 0, &
571 ! .true., .true., &
572 ! dt, state%q(:,:,1), &
573 ! state%t, state%pmid, &
574 ! state%pdel, cldn, state%q, &
575 ! ptend%q, ptend%lq, &
576 ! qaerwat, &
577 ! dgnum_pbuf, dgnumwet_pbuf, &
578 ! wetdens_pbuf )
579 !
580 ! this is the subr in wrfchem
581 ! subr------ modal_aero_wateruptake_sub( &
582 ! lchnk, ncol, nstep, &
583 ! iwaterup_flag, loffset, &
584 ! aero_mmr_flag, h2o_mmr_flag, &
585 ! deltat, h2ommr, t, pmid, pdel, cldn, &
586 ! raer, raertend, dotend, qaerwat, &
587 ! dgncur_a, dgncur_awet, wetdens &
588 !#ifdef OBSRH
589 ! , obsrh &
590 !#endif
591 ! )
592 !
593 call modal_aero_wateruptake_sub( &
594 lchnk, ncol, nstep, &
595 iwaterup_flag, loffset, &
596 aero_mmr_flag, h2o_mmr_flag, &
597 deltat8, qv8, t8, pmid8, pdel8, cld8, &
598 q8, dqdt8, dotend, qaerwat8, &
599 dgnum8, dgnumwet8, wetdens_ap8 )
601 if (idiagaa > 0) then
602 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
603 print 93010, 'backfrm modal_aero_wateruptake_sub - i,j =', i, j
604 end if
606 ! diagnostics for initial testing
607 if (idiag_wateruptake > 0) then
608 if ((i==its) .and. (j==jts)) then
609 do kcam = kts, kte, (kte-kts)
610 k = kte-kcam+1
611 write(*,'(/a,4i5,1p,e12.4)') &
612 'wateruptake diagnostics after , i, j, k, kcam, rh =', &
613 i, j, k, kcam, rh8(icol,kcam)
614 write(*,'(a,1p,7e12.4))') 'qaerwat ', &
615 ( qaerwat8(icol,kcam,n), n=1,ntot_amode )
616 write(*,'(a,1p,7e12.4))') 'dgnum ', &
617 ( dgnum8(icol,kcam,n), n=1,ntot_amode )
618 write(*,'(a,1p,7e12.4))') 'dgnumwet ', &
619 ( dgnumwet8(icol,kcam,n), n=1,ntot_amode )
620 write(*,'(a,1p,7e12.4))') 'wetdens_ap', &
621 ( wetdens_ap8(icol,kcam,n), n=1,ntot_amode )
622 end do
623 write(*,'(a/(10f8.4))') 'rh(pver:1)', &
624 ( rh8(icol,kcam), kcam=pver,1,-1 )
625 end if
626 end if ! (idiag_wateruptake > 0)
630 !--------------------------------------------------------------------
631 !
632 ! do modal_aero_gasaerexch_sub
633 !
634 !--------------------------------------------------------------------
635 if (aerchem_onoffb > 0) then
637 ! transfer mass mixing ratios in q8 and qqcw8 to molar mixing ratios in vmr8 and vmrcw8
638 do l2 = pcnst_non_chem+1, pcnst
639 l3 = l2 - pcnst_non_chem
640 fconv = mwdry/mw_q_array(l2)
641 vmr8( icol,:,l3) = q8( icol,:,l2)*fconv
642 vmrcw8(icol,:,l3) = qqcw8(icol,:,l2)*fconv
643 if (i*j==1 .and. k==kts .and. l3==l_mo_h2so4) &
644 write(*,'(a,1p,2e11.3)') '1,1,1 h2so4 q8 & vmr8', &
645 q8(icol,pver,l2), vmr8(icol,pver,l3)
646 if (i*j==1 .and. k==kts .and. l3==l_mo_soag) &
647 write(*,'(a,1p,2e11.3)') '1,1,1 soag q8 & vmr8', &
648 q8(icol,pver,l2), vmr8(icol,pver,l3)
649 end do
651 ! also convert this
652 fconv = mwdry/mw_q_mo_array(l_mo_h2so4)
653 del_h2so4_gasprod8(icol,:) = del_h2so4_gasprod8(icol,:)*fconv
655 ! save current h2so4 vmr
656 del_h2so4_aeruptk8(icol,:) = vmr8(icol,:,l_mo_h2so4)
657 tmpvmra(:,:) = vmr8(icol,:,:)
659 ! following is the cam code in mo_gas_phase_chemdr.F90
660 ! if (l_mo_h2so4 > 0) then
661 ! del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,l_mo_h2so4)
662 ! else
663 ! del_h2so4_aeruptk(:,:) = 0.0_r8
664 ! endif
665 ! call modal_aero_gasaerexch_sub( &
666 ! lchnk, ncol, nstep, &
667 ! imozart-1, delt, &
668 ! latndx, lonndx, &
669 ! tfld, pmid, pdel, &
670 ! vmr, vmrcw, &
671 ! dvmrdt_sv1, dvmrcwdt_sv1, &
672 ! dgnum_pbuf, dgnumwet_pbuf )
673 ! if (l_mo_h2so4 > 0) then
674 ! del_h2so4_aeruptk(1:ncol,:) = vmr(1:ncol,:,l_mo_h2so4) - del_h2so4_aeruptk(1:ncol,:)
675 ! endif
677 ! make call
678 if (idiagaa > 0) then
679 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
680 print 93010, 'calling modal_aero_gasaerexch_sub - i,j =', i, j
681 end if
683 call modal_aero_gasaerexch_sub( &
684 lchnk, ncol, nstep, &
685 imozart_m1, deltat8, &
686 latndx, lonndx, &
687 t8, pmid8, pdel8, &
688 vmr8, vmrcw8, &
689 dvmrdt_sv18, dvmrcwdt_sv18, &
690 dgnum8, dgnumwet8, &
691 gas_pcnst_pos )
693 if (idiagaa > 0) then
694 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
695 print 93010, 'backfrm modal_aero_gasaerexch_sub - i,j =', i, j
696 end if
698 ! diagnostic output after gasaerexch
699 if (idiag_gasaerexch > 0) then
700 if ((i == its) .and. (j == jts)) then
701 do kcam = 1, pver
702 if ((kcam /= pver) .and. (kcam /= pver-10)) cycle
704 tmpveca(:) = 0.0
705 tmpvecb(:) = 0.0
706 do n = 1, ntot_amode
707 l = lptr_so4_a_amode(n) - imozart_m1
708 if ((l > 0) .and. (l <= gas_pcnst)) then
709 tmpveca(n+2) = tmpvmra(kcam,l)
710 tmpvecb(n+2) = vmr8(icol,kcam,l)
711 end if
712 end do
713 tmpveca(2) = tmpvmra(kcam,l_mo_h2so4)
714 tmpvecb(2) = vmr8(icol,kcam,l_mo_h2so4)
715 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
716 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
717 write(*,'(/a,i3,1p,e13.5,10e11.3)') 'kcam, old so4 ...', &
718 kcam, tmpveca(1:ntot_amode+2)
719 write(*,'( a,i3,1p,e13.5,10e11.3)') 'kcam, new so4 ...', &
720 kcam, tmpvecb(1:ntot_amode+2)
722 tmpveca(:) = 0.0
723 tmpvecb(:) = 0.0
724 do n = 1, ntot_amode
725 l = lptr_soa_a_amode(n) - imozart_m1
726 if ((l > 0) .and. (l <= gas_pcnst)) then
727 tmpveca(n+2) = tmpvmra(kcam,l)
728 tmpvecb(n+2) = vmr8(icol,kcam,l)
729 end if
730 end do
731 tmpveca(2) = tmpvmra(kcam,l_mo_soag)
732 tmpvecb(2) = vmr8(icol,kcam,l_mo_soag)
733 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
734 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
735 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old soa ...', &
736 kcam, tmpveca(1:ntot_amode+2)
737 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new soa ...', &
738 kcam, tmpvecb(1:ntot_amode+2)
740 tmpveca(:) = 0.0
741 tmpvecb(:) = 0.0
742 do n = 1, ntot_amode
743 l = lptr_nacl_a_amode(n) - imozart_m1
744 if ((l > 0) .and. (l <= gas_pcnst)) then
745 tmpveca(n+2) = tmpvmra(kcam,l)
746 tmpvecb(n+2) = vmr8(icol,kcam,l)
747 end if
748 end do
749 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
750 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
751 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old ncl ...', &
752 kcam, tmpveca(1:ntot_amode+2)
753 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new ncl ...', &
754 kcam, tmpvecb(1:ntot_amode+2)
756 tmpveca(:) = 0.0
757 tmpvecb(:) = 0.0
758 do n = 1, ntot_amode
759 l = numptr_amode(n) - imozart_m1
760 if ((l > 0) .and. (l <= gas_pcnst)) then
761 tmpveca(n+2) = tmpvmra(kcam,l)
762 tmpvecb(n+2) = vmr8(icol,kcam,l)
763 end if
764 end do
765 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
766 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
767 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old num ...', &
768 kcam, tmpveca(1:ntot_amode+2)
769 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new num ...', &
770 kcam, tmpvecb(1:ntot_amode+2)
772 end do ! kcam
773 end if ! ((i == its) .and. (j == jts))
774 end if ! (idiag_gasaerexch > 0)
776 ! calc change to h2so4 vmr
777 del_h2so4_aeruptk8(icol,:) = &
778 vmr8(icol,:,l_mo_h2so4) - del_h2so4_aeruptk8(icol,:)
780 end if ! (aerchem_onoffb > 0)
784 !--------------------------------------------------------------------
785 !
786 ! do modal_aero_newnuc_sub
787 !
788 !--------------------------------------------------------------------
789 if (aernewnuc_onoffb > 0) then
790 tmpvmra(:,:) = vmr8(icol,:,:)
792 if (idiagaa > 0) then
793 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
794 print 93010, 'calling modal_aero_newnuc_sub - i,j =', i, j
795 end if
797 ! subr------ modal_aero_newnuc_sub( &
798 ! lchnk, ncol, nstep, &
799 ! pcnstxx, loffset, deltat, &
800 ! latndx, lonndx, &
801 ! t, pmid, pdel, &
802 ! zm, pblh, &
803 ! qv, cld, &
804 ! q, &
805 ! del_h2so4_gasprod, del_h2so4_aeruptk )
806 call modal_aero_newnuc_sub( &
807 lchnk, ncol, nstep, &
808 imozart_m1, deltat8, &
809 latndx, lonndx, &
810 t8, pmid8, pdel8, &
811 zm8, pblh8, &
812 qv8, cld8, &
813 vmr8, &
814 del_h2so4_gasprod8, del_h2so4_aeruptk8, &
815 gas_pcnst )
817 if (idiagaa > 0) then
818 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
819 print 93010, 'backfrm modal_aero_newnuc_sub - i,j =', i, j
820 end if
822 ! diagnostic output after newnuc
823 if (idiag_newnuc > 0) then
824 if ((i == its) .and. (j == jts)) then
825 do kcam = 1, pver
826 if ((kcam /= pver) .and. (kcam /= pver-10)) cycle
828 tmpveca(:) = 0.0
829 tmpvecb(:) = 0.0
830 do n = 1, ntot_amode
831 l = lptr_so4_a_amode(n) - imozart_m1
832 if ((l > 0) .and. (l <= gas_pcnst)) then
833 tmpveca(n+2) = tmpvmra(kcam,l)
834 tmpvecb(n+2) = vmr8(icol,kcam,l)
835 end if
836 end do
837 tmpveca(2) = tmpvmra(kcam,l_mo_h2so4)
838 tmpvecb(2) = vmr8(icol,kcam,l_mo_h2so4)
839 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
840 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
841 write(*,'(/a,i3,1p,e13.5,10e11.3)') 'kcam, old so4 ...', &
842 kcam, tmpveca(1:ntot_amode+2)
843 write(*,'( a,i3,1p,e13.5,10e11.3)') 'kcam, new so4 ...', &
844 kcam, tmpvecb(1:ntot_amode+2)
846 tmpveca(:) = 0.0
847 tmpvecb(:) = 0.0
848 do n = 1, ntot_amode
849 l = lptr_soa_a_amode(n) - imozart_m1
850 if ((l > 0) .and. (l <= gas_pcnst)) then
851 tmpveca(n+2) = tmpvmra(kcam,l)
852 tmpvecb(n+2) = vmr8(icol,kcam,l)
853 end if
854 end do
855 tmpveca(2) = tmpvmra(kcam,l_mo_soag)
856 tmpvecb(2) = vmr8(icol,kcam,l_mo_soag)
857 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
858 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
859 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old soa ...', &
860 kcam, tmpveca(1:ntot_amode+2)
861 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new soa ...', &
862 kcam, tmpvecb(1:ntot_amode+2)
864 tmpveca(:) = 0.0
865 tmpvecb(:) = 0.0
866 do n = 1, ntot_amode
867 l = lptr_nacl_a_amode(n) - imozart_m1
868 if ((l > 0) .and. (l <= gas_pcnst)) then
869 tmpveca(n+2) = tmpvmra(kcam,l)
870 tmpvecb(n+2) = vmr8(icol,kcam,l)
871 end if
872 end do
873 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
874 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
875 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old ncl ...', &
876 kcam, tmpveca(1:ntot_amode+2)
877 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new ncl ...', &
878 kcam, tmpvecb(1:ntot_amode+2)
880 tmpveca(:) = 0.0
881 tmpvecb(:) = 0.0
882 do n = 1, ntot_amode
883 l = numptr_amode(n) - imozart_m1
884 if ((l > 0) .and. (l <= gas_pcnst)) then
885 tmpveca(n+2) = tmpvmra(kcam,l)
886 tmpvecb(n+2) = vmr8(icol,kcam,l)
887 end if
888 end do
889 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
890 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
891 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old num ...', &
892 kcam, tmpveca(1:ntot_amode+2)
893 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new num ...', &
894 kcam, tmpvecb(1:ntot_amode+2)
896 end do ! kcam
897 end if ! ((i == its) .and. (j == jts))
898 end if ! (idiag_newnuc > 0)
900 end if ! (aernewnuc_onoffb > 0)
904 !--------------------------------------------------------------------
905 !
906 ! do modal_aero_coag_sub
907 !
908 !--------------------------------------------------------------------
909 if (aercoag_onoffb > 0) then
910 tmpvmra(:,:) = vmr8(icol,:,:)
912 if (idiagaa > 0) then
913 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
914 print 93010, 'calling modal_aero_coag_sub - i,j =', i, j
915 end if
917 ! subr------ modal_aero_coag_sub( &
918 ! lchnk, ncol, nstep, &
919 ! pcnstxx, loffset, deltat_main, &
920 ! latndx, lonndx, &
921 ! t, pmid, pdel, &
922 ! q, &
923 ! dgncur_a, dgncur_awet, &
924 ! wetdens_a )
925 call modal_aero_coag_sub( &
926 lchnk, ncol, nstep, &
927 imozart_m1, deltat8, &
928 latndx, lonndx, &
929 t8, pmid8, pdel8, &
930 vmr8, &
931 dgnum8, dgnumwet8, &
932 wetdens_ap8, gas_pcnst )
934 if (idiagaa > 0) then
935 if (mod(i-its,idiagaa_idel)==0 .and. mod(j-jts,idiagaa_jdel)==0) &
936 print 93010, 'backfrm modal_aero_coag_sub - i,j =', i, j
937 end if
939 ! diagnostic output after coag
940 if (idiag_coag > 0) then
941 if ((i == its) .and. (j == jts)) then
942 do kcam = 1, pver
943 if ((kcam /= pver) .and. (kcam /= pver-10)) cycle
945 tmpveca(:) = 0.0
946 tmpvecb(:) = 0.0
947 do n = 1, ntot_amode
948 l = lptr_so4_a_amode(n) - imozart_m1
949 if ((l > 0) .and. (l <= gas_pcnst)) then
950 tmpveca(n+2) = tmpvmra(kcam,l)
951 tmpvecb(n+2) = vmr8(icol,kcam,l)
952 end if
953 end do
954 tmpveca(2) = tmpvmra(kcam,l_mo_h2so4)
955 tmpvecb(2) = vmr8(icol,kcam,l_mo_h2so4)
956 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
957 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
958 write(*,'(/a,i3,1p,e13.5,10e11.3)') 'kcam, old so4 ...', &
959 kcam, tmpveca(1:ntot_amode+2)
960 write(*,'( a,i3,1p,e13.5,10e11.3)') 'kcam, new so4 ...', &
961 kcam, tmpvecb(1:ntot_amode+2)
963 tmpveca(:) = 0.0
964 tmpvecb(:) = 0.0
965 do n = 1, ntot_amode
966 l = lptr_nacl_a_amode(n) - imozart_m1
967 if ((l > 0) .and. (l <= gas_pcnst)) then
968 tmpveca(n+2) = tmpvmra(kcam,l)
969 tmpvecb(n+2) = vmr8(icol,kcam,l)
970 end if
971 end do
972 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
973 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
974 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old ncl ...', &
975 kcam, tmpveca(1:ntot_amode+2)
976 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new ncl ...', &
977 kcam, tmpvecb(1:ntot_amode+2)
979 tmpveca(:) = 0.0
980 tmpvecb(:) = 0.0
981 do n = 1, ntot_amode
982 l = numptr_amode(n) - imozart_m1
983 if ((l > 0) .and. (l <= gas_pcnst)) then
984 tmpveca(n+2) = tmpvmra(kcam,l)
985 tmpvecb(n+2) = vmr8(icol,kcam,l)
986 end if
987 end do
988 tmpveca(1) = sum( tmpveca(2:ntot_amode+2) )
989 tmpvecb(1) = sum( tmpvecb(2:ntot_amode+2) )
990 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, old num ...', &
991 kcam, tmpveca(1:ntot_amode+2)
992 write(*,'(a,i3,1p,e13.5,10e11.3)') 'kcam, new num ...', &
993 kcam, tmpvecb(1:ntot_amode+2)
995 end do ! kcam
996 end if ! ((i == its) .and. (j == jts))
997 end if ! (idiag_coag > 0)
999 end if ! (aercoag_onoffb > 0)
1003 !--------------------------------------------------------------------
1004 !
1005 ! after doing modal_aero_gasaerexch_sub (and newnuc, coag, ...),
1006 ! transfer final mixing ratios from vmr to q arrays
1007 !
1008 !--------------------------------------------------------------------
1009 if (aerchem_onoffb > 0) then
1011 ! transfer molar mixing ratios in vmr8 and vmrcw8 back to mass mixing ratios in q8 and qqcw8
1012 do l2 = pcnst_non_chem+1, pcnst
1013 l3 = l2 - pcnst_non_chem
1014 fconv = mw_q_array(l2)/mwdry
1015 q8( icol,:,l2) = vmr8( icol,:,l3)*fconv
1016 qqcw8(icol,:,l2) = vmrcw8(icol,:,l3)*fconv
1017 if (i*j==1 .and. k==kts .and. l3==l_mo_h2so4) &
1018 write(*,'(a,1p,2e11.3)') '1,1,1 h2so4 q8 & vmr8', &
1019 q8(icol,pver,l2), vmr8(icol,pver,l3)
1020 if (i*j==1 .and. k==kts .and. l3==l_mo_soag) &
1021 write(*,'(a,1p,2e11.3)') '1,1,1 soag q8 & vmr8', &
1022 q8(icol,pver,l2), vmr8(icol,pver,l3)
1023 end do
1025 end if ! (aerchem_onoffb > 0)
1029 !--------------------------------------------------------------------
1030 !
1031 ! transfer updated data from cam to wrf-chem variables
1032 !
1033 !--------------------------------------------------------------------
1034 ! unload the cam layer-center variables that have been modified
1035 ! (reverse the vertical index, and convert units as needed)
1036 do k = kts, kte
1037 kcam = kte-k+1
1039 do n = 1, ntype_aer
1040 dgnum(i,k,j,n) = dgnum8(icol,kcam,n)
1041 dgnumwet(i,k,j,n) = dgnumwet8(icol,kcam,n)
1042 wetdens_ap(i,k,j,n) = wetdens_ap8(icol,kcam,n)
1044 l = waterptr_aer(1,n)
1045 if ((l >= p1st) .and. (l <= num_chem)) &
1046 chem(i,k,j,l) = qaerwat8(icol,kcam,n)/factconv_chem_to_q(l)
1047 end do ! n
1049 do l = p1st, num_chem
1050 l2 = lptr_chem_to_q(l)
1051 if ((l2 >= 1) .and. (l2 <= pcnst)) then
1052 chem(i,k,j,l) = q8(icol,kcam,l2)/factconv_chem_to_q(l)
1053 end if
1054 if (i*j==1 .and. k==kts .and. l2==l_mo_h2so4+pcnst_non_chem) &
1055 write(*,'(a,1p,2e11.3)') '1,1,1 h2so4 chem & q8', &
1056 chem(i,k,j,l), q8(icol,kcam,l2)
1057 if (i*j==1 .and. k==kts .and. l2==l_mo_soag+pcnst_non_chem) &
1058 write(*,'(a,1p,2e11.3)') '1,1,1 soag chem & q8', &
1059 chem(i,k,j,l), q8(icol,kcam,l2)
1060 ! cycle
1062 l2 = lptr_chem_to_qqcw(l)
1063 if ((l2 >= 1) .and. (l2 <= pcnst)) then
1064 chem(i,k,j,l) = qqcw8(icol,kcam,l2)/factconv_chem_to_q(l)
1065 end if
1066 end do ! l
1068 end do
1072 !--------------------------------------------------------------------
1073 !
1074 ! End of main loop over the points in the tile (which treats them each as a CAM chunk)
1075 !
1076 !--------------------------------------------------------------------
1077 2910 continue
1078 2920 continue
1081 print 93010, 'leaving cam_mam_aerchem_driver - ktau =', ktau
1082 93010 format( a, 8(1x,i6) )
1084 return
1085 end subroutine cam_mam_aerchem_driver
1088 !-----------------------------------------------------------------------
1089 subroutine sum_pm_cam_mam ( &
1090 alt, chem, &
1091 pm2_5_dry, pm2_5_water, pm2_5_dry_ec, pm10, &
1092 ids,ide, jds,jde, kds,kde, &
1093 ims,ime, jms,jme, kms,kme, &
1094 its,ite, jts,jte, kts,kte )
1096 USE module_state_description, only: num_chem
1097 USE module_data_mosaic_asect
1098 IMPLICIT NONE
1100 INTEGER, INTENT(IN ) :: &
1101 ids,ide, jds,jde, kds,kde, &
1102 ims,ime, jms,jme, kms,kme, &
1103 its,ite, jts,jte, kts,kte
1105 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
1106 INTENT(IN) :: alt
1108 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
1109 INTENT(IN ) :: chem
1111 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
1112 INTENT(OUT) :: pm2_5_dry,pm2_5_water,pm2_5_dry_ec,pm10
1114 REAL :: mass
1116 INTEGER :: i,imax,j,jmax,k,kmax,n,itype,iphase
1118 imax = min(ite,ide-1)
1119 jmax = min(jte,jde-1)
1120 kmax = kte
1121 !
1122 ! Sum over bins with center diameter < 2.5e-4 cm for pm2_5_dry,
1123 ! pm2_5_dry_ec, and pm2_5_water. All bins go into pm10
1124 !
1125 pm2_5_dry(its:imax,kts:kmax,jts:jmax) = 0.
1126 pm2_5_dry_ec(its:imax,kts:kmax,jts:jmax) = 0.
1127 pm2_5_water(its:imax,kts:kmax,jts:jmax) = 0.
1128 pm10(its:imax,kts:kmax,jts:jmax) = 0.
1130 do iphase=1,nphase_aer
1131 do itype=1,ntype_aer
1132 do n = 1, nsize_aer(itype)
1133 if (dcen_sect(n,itype) .le. 2.5e-4) then
1134 do j=jts,jmax
1135 do k=kts,kmax
1136 do i=its,imax
1137 mass = chem(i,k,j,lptr_so4_aer(n,itype,iphase)) &
1138 + chem(i,k,j,lptr_no3_aer(n,itype,iphase)) &
1139 + chem(i,k,j,lptr_cl_aer(n,itype,iphase)) &
1140 + chem(i,k,j,lptr_nh4_aer(n,itype,iphase)) &
1141 + chem(i,k,j,lptr_na_aer(n,itype,iphase)) &
1142 + chem(i,k,j,lptr_oin_aer(n,itype,iphase)) &
1143 + chem(i,k,j,lptr_oc_aer(n,itype,iphase)) &
1144 + chem(i,k,j,lptr_bc_aer(n,itype,iphase))
1146 pm2_5_dry(i,k,j) = pm2_5_dry(i,k,j) + mass
1148 pm2_5_dry_ec(i,k,j) = pm2_5_dry_ec(i,k,j) &
1149 + chem(i,k,j,lptr_bc_aer(n,itype,iphase))
1151 pm2_5_water(i,k,j) = pm2_5_water(i,k,j) &
1152 + chem(i,k,j,waterptr_aer(n,itype))
1154 pm10(i,k,j) = pm10(i,k,j) + mass
1155 enddo
1156 enddo
1157 enddo
1158 else
1159 do j=jts,jmax
1160 do k=kts,kmax
1161 do i=its,imax
1162 pm10(i,k,j) = pm10(i,k,j) &
1163 + chem(i,k,j,lptr_so4_aer(n,itype,iphase)) &
1164 + chem(i,k,j,lptr_no3_aer(n,itype,iphase)) &
1165 + chem(i,k,j,lptr_cl_aer(n,itype,iphase)) &
1166 + chem(i,k,j,lptr_nh4_aer(n,itype,iphase)) &
1167 + chem(i,k,j,lptr_na_aer(n,itype,iphase)) &
1168 + chem(i,k,j,lptr_oin_aer(n,itype,iphase)) &
1169 + chem(i,k,j,lptr_oc_aer(n,itype,iphase)) &
1170 + chem(i,k,j,lptr_bc_aer(n,itype,iphase))
1171 enddo
1172 enddo
1173 enddo
1174 endif
1175 enddo ! size
1176 enddo ! type
1177 enddo ! phase
1179 !Convert the units from mixing ratio to concentration (ug m^-3)
1180 pm2_5_dry(its:imax,kts:kmax,jts:jmax) = pm2_5_dry(its:imax,kts:kmax,jts:jmax) &
1181 / alt(its:imax,kts:kmax,jts:jmax)
1182 pm2_5_dry_ec(its:imax,kts:kmax,jts:jmax) = pm2_5_dry_ec(its:imax,kts:kmax,jts:jmax) &
1183 / alt(its:imax,kts:kmax,jts:jmax)
1184 pm2_5_water(its:imax,kts:kmax,jts:jmax) = pm2_5_water(its:imax,kts:kmax,jts:jmax) &
1185 / alt(its:imax,kts:kmax,jts:jmax)
1186 pm10(its:imax,kts:kmax,jts:jmax) = pm10(its:imax,kts:kmax,jts:jmax) &
1187 / alt(its:imax,kts:kmax,jts:jmax)
1189 end subroutine sum_pm_cam_mam
1194 !==============================================================
1195 end module module_cam_mam_aerchem_driver