| blob | 9c4c8cb1a8afc5287fb7a4aa60b7a1472670095e |
1 !
2 ! WRF-chem V3.0 : Original version of emission_driver written by Georg Grell (ESRL/GSD)
3 ! Further developments, bugfixes and improvements by
4 ! William Gustafson (PNNL), Serena Chung (WSU),
5 ! Saulo Freitas (CPTEC), and Georg Grell
6 !
7 !
8 ! A. Ukhov, 11 March 2021, remove unused parameters in gocart_dust_driver(),
9 ! gocart_dust_afwa_driver(), and uoc_dust_driver() subroutines.
11 MODULE module_emissions_driver
12 IMPLICIT NONE
13 CONTAINS
15 subroutine emissions_driver(id,ktau,dtstep,DX, &
16 adapt_step_flag,curr_secs, &
17 plumerisefire_frq,stepfirepl, &
18 bioemdt,stepbioe, &
19 config_flags,gmt,julday,alt,t_phy,moist,p8w,t8w,u_phy, &
20 v_phy,vvel,e_bio,p_phy,chem,rho_phy,dz8w,ne_area,emis_ant, &
21 emis_vol,tsk,erod,erod_dri,lai_vegmask, &
22 g,emis_seas,emis_dust,tracer, &
23 emis_seas2, &
24 ebu, ebu_in,mean_fct_agtf,mean_fct_agef, &
25 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
26 firesize_agsv,firesize_aggr, &
27 u10,v10,ivgtyp,isltyp,gsw,vegfra,rmol,ust,znt,dms_0, &
28 erup_beg,erup_end, &
29 xland,xlat,xlong,z_at_w,z,smois,dustin,seasin, &
30 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
31 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
32 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
33 sebio_sesq,sebio_mbo, &
34 noag_grow,noag_nongrow,nononag,slai, &
35 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
36 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
37 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
38 ebio_sesq, ebio_mbo,ebio_bpi,ebio_myrc, &
39 ebio_c10h16,ebio_tol,ebio_bigalk,ebio_ch3oh,ebio_acet, &
40 ebio_nh3,ebio_no2,ebio_c2h5oh,ebio_ch3cooh,ebio_mek, &
41 ebio_bigene,ebio_c2h6,ebio_c2h4,ebio_c3h6,ebio_c3h8,ebio_so2, &
42 ebio_dms,ebio_hcn, &
43 ebio_alk3, ebio_alk4, ebio_alk5, ebio_ole1, ebio_ole2, &
44 ebio_aro1, ebio_aro2, ebio_ccho, ebio_meoh, &
45 ebio_ethene, ebio_hcooh, ebio_terp, ebio_bald, &
46 ebio_cco_oh, ebio_rco_oh, &
47 clayfrac,sandfrac,dust_alpha,dust_gamma,dust_smtune,dust_ustune, &
48 clayfrac_nga,sandfrac_nga, &
49 snowh,zs,afwa_dustloft,tot_dust,tot_edust,vis_dust, &
50 soil_top_cat, ust_t, rough_cor, smois_cor, &
51 ebio_c5h8,ebio_apinene,ebio_bpinene,ebio_toluene, &
52 ebio_ch3cho,ebio_ch3co2h,ebio_tbut2ene,ebio_c2h5cho, &
53 ebio_nc4h10, &
54 ! stuff for MEGAN v2.04
55 T2,swdown, &
56 nmegan,EFmegan, &
57 msebio_isop, &
58 mlai, &
59 pftp_bt, pftp_nt, pftp_sb, pftp_hb, &
60 mtsa, &
61 mswdown, &
62 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
63 mebio_acet, mebio_mbo, mebio_no, &
64 current_month, &
65 ! end stuff for MEGAN v2.04
66 ! stuff for LNOx emissions
67 ht, refl_10cm, &
68 ic_flashrate, cg_flashrate, &
69 ! end stuff for LNOx emissions
70 ! stuff for aircraft emissions
71 emis_aircraft, &
72 ! stuff for GHG fluxes
73 vprm_in,rad_vprm,lambda_vprm,alpha_vprm,resp_vprm, &
74 xtime,tslb,wet_in,rainc,rainnc,potevp,sfcevp,lu_index, &
75 biomt_par,emit_par,ebio_co2oce,eghg_bio, &
76 seas_flux, &
77 ids,ide, jds,jde, kds,kde, &
78 ims,ime, jms,jme, kms,kme, &
79 its,ite, jts,jte, kts,kte )
80 !----------------------------------------------------------------------
81 USE module_configure
82 USE module_state_description
83 USE module_data_radm2
84 USE module_data_sorgam, only : mw_so4_aer,anthfac,factnumn,factnuma,factnumc
85 USE module_model_constants, only : mwdry
86 USE module_emissions_anthropogenics
87 USE module_bioemi_simple
88 USE module_bioemi_beis314
89 USE module_bioemi_megan2
90 USE module_aerosols_sorgam, only: sorgam_addemiss
91 USE module_cbmz_addemiss
92 USE module_cb05_addemiss
93 USE gocart_dust
94 USE gocart_dust_afwa
95 USE gocart_seasalt
96 USE uoc_dust
97 USE module_dms_emis
98 USE module_mosaic_addemiss
99 USE module_add_emis_cptec
100 USE module_add_emiss_burn
101 USE module_plumerise1
102 USE module_aerosols_sorgam_vbs, only: sorgam_vbs_addemiss
103 USE module_aerosols_soa_vbs, only: soa_vbs_addemiss
104 USE module_ghg_fluxes
105 USE module_lightning_nox_driver
106 USE module_cam_mam_addemiss, only: cam_mam_addemiss
107 #if( WRF_USE_CLM == 1)
108 USE shr_megan_mod, only : shr_megan_mechcomps_n, shr_megan_mechcomps
109 #endif
111 IMPLICIT NONE
113 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
115 INTEGER, INTENT(IN ) :: id,julday, ne_area, &
116 ids,ide, jds,jde, kds,kde, &
117 ims,ime, jms,jme, kms,kme, &
118 its,ite, jts,jte, kts,kte
119 INTEGER, INTENT(IN ) :: &
120 ktau,stepbioe,stepfirepl
121 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
122 INTENT(IN ) :: moist
123 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
124 INTENT(INOUT ) :: chem
125 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_tracer ), &
126 INTENT(INOUT ) :: tracer
127 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_ebu ), &
128 INTENT(INOUT ) :: ebu
129 REAL, DIMENSION( ims:ime, 1, jms:jme, num_ebu_in ), &
130 INTENT(INOUT ) :: ebu_in
131 REAL, DIMENSION( ims:ime, jms:jme, ne_area ), &
132 INTENT(INOUT ) :: e_bio
133 REAL, DIMENSION( ims:ime, 1:config_flags%kemit, jms:jme,num_emis_ant),&
134 INTENT(IN ) :: &
135 emis_ant
136 REAL, DIMENSION( ims:ime, kms:kme, jms:jme,num_emis_vol), &
137 INTENT(INOUT ) :: &
138 emis_vol
139 REAL, DIMENSION( ims:ime, jms:jme),&
140 INTENT(IN ) :: &
141 dms_0,tsk,erup_beg,erup_end
142 REAL, DIMENSION( ims:ime, jms:jme,3),&
143 INTENT(IN ) :: &
144 erod, erod_dri
145 REAL, DIMENSION( ims:ime, jms:jme), &
146 INTENT(IN ) :: &
147 lai_vegmask
148 REAL, DIMENSION( ims:ime, jms:jme,5),&
149 INTENT(INOUT ) :: &
150 dustin,seasin
151 REAL, DIMENSION( ims:ime, 1, jms:jme,num_emis_dust), &
152 OPTIONAL, INTENT(INOUT ) :: &
153 emis_dust
154 REAL, DIMENSION( ims:ime, 1, jms:jme,num_emis_seas), &
155 OPTIONAL, &
156 INTENT(INOUT ) :: &
157 emis_seas
158 REAL, DIMENSION( ims:ime, 1, jms:jme,num_emis_seas2), &
159 OPTIONAL, &
160 INTENT(INOUT ) :: &
161 emis_seas2
162 REAL, DIMENSION( ims:ime, jms:jme ), &
163 OPTIONAL, &
164 INTENT(IN ) :: &
165 mean_fct_agtf,mean_fct_agef, &
166 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
167 firesize_agsv,firesize_aggr
169 !
170 !
171 !
172 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
173 INTENT(IN ) :: &
174 alt, &
175 t_phy, &
176 p_phy, &
177 dz8w, &
178 t8w,p8w,z_at_w , z , &
179 u_phy,v_phy,vvel,rho_phy
180 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
181 INTENT(IN ) :: &
182 ivgtyp, &
183 isltyp
184 REAL, DIMENSION( ims:ime , jms:jme ) , &
185 INTENT(IN ) :: &
186 u10, &
187 v10, &
188 gsw, &
189 vegfra, &
190 rmol, &
191 ust, &
192 xland, &
193 xlat, &
194 xlong, &
195 znt, &
197 ! Add for the GHG_tracer option
198 rainc, &
199 rainnc, &
200 potevp, &
201 sfcevp, &
202 lu_index
204 REAL, DIMENSION( ims:ime , jms:jme ) , &
205 OPTIONAL, &
206 INTENT(IN ) :: &
207 clayfrac, &
208 sandfrac, &
209 clayfrac_nga, &
210 sandfrac_nga, &
211 snowh
212 REAL, INTENT(IN ) :: dust_alpha, &
213 dust_gamma, &
214 dust_smtune, &
215 dust_ustune
217 REAL, DIMENSION( config_flags%num_soil_layers ) , &
218 INTENT(IN ) :: zs
219 REAL, DIMENSION( ims:ime , jms:jme ) , &
220 OPTIONAL, &
221 INTENT( OUT) :: &
222 tot_edust, &
223 afwa_dustloft
224 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
225 OPTIONAL, &
226 INTENT( OUT) :: &
227 tot_dust, &
228 vis_dust
229 REAL, DIMENSION( ims:ime, config_flags%num_soil_layers, jms:jme ) , &
230 INTENT(INOUT ) :: smois, tslb
232 REAL, DIMENSION( ims:ime , jms:jme ) , &
233 OPTIONAL, &
234 INTENT(INOUT ) :: &
235 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
236 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
237 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
238 sebio_sesq,sebio_mbo, &
239 noag_grow,noag_nongrow,nononag,slai, &
240 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
241 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
242 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
243 ebio_sesq,ebio_mbo,ebio_bpi,ebio_myrc, &
244 ebio_c10h16,ebio_tol,ebio_bigalk, ebio_ch3oh,ebio_acet, &
245 ebio_nh3,ebio_no2,ebio_c2h5oh,ebio_ch3cooh,ebio_mek, &
246 ebio_bigene,ebio_c2h6,ebio_c2h4,ebio_c3h6,ebio_c3h8, &
247 ebio_so2,ebio_dms, ebio_co2oce , ebio_hcn, &
248 ebio_alk3, ebio_alk4, ebio_alk5, ebio_ole1, ebio_ole2, &
249 ebio_aro1, ebio_aro2, ebio_ccho, ebio_meoh, &
250 ebio_ethene, ebio_hcooh, ebio_terp, ebio_bald, &
251 ebio_cco_oh, ebio_rco_oh, &
252 ebio_c5h8,ebio_apinene,ebio_bpinene,ebio_toluene, &
253 ebio_ch3cho,ebio_ch3co2h,ebio_tbut2ene,ebio_c2h5cho, &
254 ebio_nc4h10
256 REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL , &
257 INTENT(INOUT) :: ust_t, &
258 rough_cor, &
259 smois_cor
260 ! dust source area information from WPS
261 REAL, DIMENSION(ims:ime,1:config_flags%num_soil_cat,jms:jme) , &
262 INTENT(IN):: soil_top_cat
264 ! stuff for MEGAN v2.04...most of these arrays are optional and package dependent
265 ! as declared in registry.chem
267 integer, intent(in ) :: nmegan
268 real, dimension (ims:ime, jms:jme , nmegan) , &
269 OPTIONAL, &
270 intent(inout) :: &
271 EFmegan
274 real, dimension (ims:ime, jms:jme ) , &
275 OPTIONAL, &
276 intent(in) :: &
277 msebio_isop, &
278 pftp_bt, pftp_nt, pftp_sb, pftp_hb
280 real, dimension (ims:ime, jms:jme, 12 ) , &
281 OPTIONAL, &
282 intent(in) :: &
283 mlai, mtsa, mswdown
285 real, dimension (ims:ime, jms:jme ) , &
286 OPTIONAL, &
287 intent(inout) :: &
288 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
289 mebio_acet, mebio_mbo, mebio_no
291 real, dimension (ims:ime, jms:jme ) , &
292 intent(in) :: &
293 T2, swdown
295 integer, intent(in) :: current_month
297 ! end stuff for MEGAN v2.04
299 REAL(KIND=8), INTENT(IN ) :: &
300 curr_secs
302 REAL :: gmtp,gmtm
303 integer :: curr_hours,ivolcano
304 Integer :: endhr,endmin,beghr,begmin,ko,kk4,kl,k_initial,k_final
305 real :: emiss_ash_mass,emiss_ash_height,so2_mass,vert_mass_dist(kts:kte)
306 real :: eh
307 real :: area,x1,percen_mass_umbrel,base_umbrel,ashz_above_vent
309 REAL, INTENT(IN ) :: &
310 bioemdt, dtstep, dx, gmt, g
312 INTEGER, INTENT(IN ) :: &
313 plumerisefire_frq
315 LOGICAL, INTENT(IN ) :: &
316 adapt_step_flag
317 ! stuff for aircraft emissions
319 REAL, DIMENSION( ims:ime, 1:config_flags%kemit_aircraft, jms:jme,num_emis_aircraft), &
320 OPTIONAL, INTENT(IN ) :: emis_aircraft
321 !
322 ! stuff for ghg tracer
324 REAL, DIMENSION(ims:ime, 8, jms:jme, num_vprm_in), INTENT(IN) :: vprm_in
325 REAL, DIMENSION(ims:ime, 1,jms:jme, num_eghg_bio), INTENT(INOUT ) :: eghg_bio
327 REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: seas_flux
328 ! CO2
329 REAL, DIMENSION(8) :: rad_vprm,lambda_vprm,alpha_vprm,resp_vprm
330 ! CH4
331 REAL, DIMENSION(14), INTENT(IN) :: biomt_par, emit_par
332 REAL, DIMENSION(ims:ime,1,jms:jme,num_wet_in), INTENT(IN) :: wet_in
333 REAL, INTENT(IN) :: xtime
334 ! end ghg tracer stuff
335 ! stuff for lightning NOx
336 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ht, ic_flashrate, cg_flashrate
337 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: refl_10cm
338 ! end stuff for lightning NOx
339 !
340 ! Local variables...
341 !
342 INTEGER :: begday,endday,i, j, k, m, p_in_chem, ksub, dust_emiss_active, seasalt_emiss_active,emiss_ash_hgt
343 REAL :: conv,conv3,conv4,oconv3,oconv4
344 #if( WRF_USE_CLM == 1)
345 REAL :: convert2(its:ite,jts:jte)
346 #endif
347 CHARACTER (LEN=80) :: message
348 LOGICAL :: do_bioemiss, do_plumerisefire,do_ex_volcanoe
350 INTEGER :: imod ! dust scheme option from namelist
353 ! ..
354 ! ..
355 ! .. Intrinsic Functions ..
356 ! INTRINSIC max, min
357 ! ..
359 ! Flags for turning on or off sea salt and/or dust emissions...
360 ! for PNNL modules: >0 = sea salt/dust emissions turned on
361 ! As of NOV 2008 these only are used for MOSAIC and SORGAM
362 ! gocart dust and seasalt will only work for GOCART and SORGAM
363 ! DL - 06/02/2013 - added option for MOSAIC-PDFiTE seasalt emissions (with organic fraction)
364 percen_mass_umbrel=.75
365 base_umbrel=.25 ! fraction
367 ivolcano=0
368 area=dx*dx
369 dust_emiss_active = 0
370 seasalt_emiss_active = 0
371 if(config_flags%dust_opt >= 2 )dust_emiss_active = 1
372 if(config_flags%seas_opt == 2 )seasalt_emiss_active = 1
373 if(config_flags%seas_opt == 3 )seasalt_emiss_active = 3
374 if(config_flags%seas_opt == 4 )seasalt_emiss_active = 4
376 !
377 ! Setup the timing flags...
378 ! (methodology is adapated from module_radiation_driver.F)
379 gmtp=curr_secs/3600.
380 curr_hours=curr_secs/3600.
381 gmtp=mod(gmt+gmtp,24.)
382 gmtm=mod(gmtp,60.)
383 ! write(0,*) 'gmtp,gmtm,curr_secs = ',gmtp,gmtm,curr_secs
384 !
385 if(config_flags%emiss_opt_vol == 1 .or. config_flags%emiss_opt_vol == 2)then
386 do_ex_volcanoe = .false.
387 !
388 emiss_ash_height = config_flags%emiss_ash_hgt
389 if(emiss_ash_height.gt. 1.)then
390 write(message,'(" ADJUSTED ASH HEIGHT: ",2f15.3)') emiss_ash_height, area
391 CALL WRF_DEBUG (15,message)
392 ! for volcanic ash transport, vash variables are in mix ratio here...
394 do j=jts,jte
395 do i=its,ite
396 if(erup_end(i,j).gt.0)then
397 so2_mass=1.5e4*3600.*1.e9/64./area
398 eh=2600.*(emiss_ash_height*.0005)**4.1494
399 emiss_ash_mass=eh*1.e9/area
401 ! volcanic emissions
402 !
403 ashz_above_vent=emiss_ash_height - z_at_w(i,kts,j)
404 write(message,'("Found and adjusted active volcano at j,kts,kpe = ",3i8)') j,kts,kte
405 call wrf_message (message)
406 ! write(0,*)emiss_ash_height,emiss_ash_mass,ashz_above_vent
407 do k=kte-1,kts,-1
408 if(z_at_w(i,k,j) < emiss_ash_height)then
409 k_final=k+1
410 exit
411 endif
412 enddo
413 do k=kte-1,kts,-1
414 if(z_at_w(i,k,j) < ((1.-base_umbrel)*ashz_above_vent)+z_at_w(i,kts,j))then
415 k_initial=k
416 exit
417 endif
418 enddo
419 vert_mass_dist=0.
420 ! write(0,*)k_initial,k_final,kte
421 !- parabolic vertical distribution between k_initial and k_final
422 kk4 = k_final-k_initial+2
423 do ko=1,kk4-1
424 kl=ko+k_initial-1
425 vert_mass_dist(kl) = 6.*percen_mass_umbrel* float(ko) &
426 /float(kk4)**2 * (1. - float(ko)/float(kk4))
427 enddo
428 if(sum(vert_mass_dist(kts:kte)) .ne. percen_mass_umbrel) then
429 x1= ( percen_mass_umbrel- sum(vert_mass_dist(kts:kte)) ) &
430 /float(k_final-k_initial+1)
431 do ko=k_initial,k_final
432 !- values between 0 and 1.
433 vert_mass_dist(ko) = vert_mass_dist(ko)+ x1
434 enddo
435 endif
437 !linear detrainment from vent to base of umbrella
438 do ko=1,k_initial-1
439 vert_mass_dist(ko)=float(ko)/float(k_initial-1)
440 enddo
441 x1=sum(vert_mass_dist(1:k_initial-1))
442 do ko=1,k_initial-1
443 vert_mass_dist(ko)=(1.-percen_mass_umbrel)*vert_mass_dist(ko)/x1
444 enddo
445 do ko=1,k_final
446 emis_vol(i,ko,j,p_e_vash1)=.22*vert_mass_dist(ko)*emiss_ash_mass
447 emis_vol(i,ko,j,p_e_vash2)=.05*vert_mass_dist(ko)*emiss_ash_mass
448 emis_vol(i,ko,j,p_e_vash3)=.4*vert_mass_dist(ko)*emiss_ash_mass
449 emis_vol(i,ko,j,p_e_vash4)=.05*vert_mass_dist(ko)*emiss_ash_mass
450 emis_vol(i,ko,j,p_e_vash5)=.245*vert_mass_dist(ko)*emiss_ash_mass
451 emis_vol(i,ko,j,p_e_vash6)=.12*vert_mass_dist(ko)*emiss_ash_mass
452 emis_vol(i,ko,j,p_e_vash7)=.11*vert_mass_dist(ko)*emiss_ash_mass
453 emis_vol(i,ko,j,p_e_vash8)=.08*vert_mass_dist(ko)*emiss_ash_mass
454 emis_vol(i,ko,j,p_e_vash9)=.05*vert_mass_dist(ko)*emiss_ash_mass
455 emis_vol(i,ko,j,p_e_vash10)=.035*vert_mass_dist(ko)*emiss_ash_mass
456 if(config_flags%emiss_opt_vol == 2)emis_vol(i,ko,j,p_e_vso2)=vert_mass_dist(ko)*so2_mass
457 enddo
458 do ko=k_final+1,kte
459 emis_vol(i,ko,j,p_e_vash1)=0.
460 emis_vol(i,ko,j,p_e_vash2)=0.
461 emis_vol(i,ko,j,p_e_vash3)=0.
462 emis_vol(i,ko,j,p_e_vash4)=0.
463 emis_vol(i,ko,j,p_e_vash5)=0.
464 emis_vol(i,ko,j,p_e_vash6)=0.
465 emis_vol(i,ko,j,p_e_vash7)=0.
466 emis_vol(i,ko,j,p_e_vash8)=0.
467 emis_vol(i,ko,j,p_e_vash9)=0.
468 emis_vol(i,ko,j,p_e_vash10)=0.
469 if(config_flags%emiss_opt_vol == 2)emis_vol(i,ko,j,p_e_vso2)=0.
470 enddo
471 endif ! erup_end
472 enddo ! i
473 enddo ! j
474 else
475 ! write(message,'(" NO ADJUSTED ASH HEIGHT: ")')
476 ! CALL WRF_MESSAGE (message)
477 endif ! emiss_ash_hgt
478 !
479 !
480 ! now we got volcanoc emissions, they need to be added to chem array
481 !
482 ! write(message,'(" Do volcanic emissions ")')
483 ! CALL WRF_MESSAGE (message)
484 do j=jts,jte
485 do i=its,ite
486 ivolcano = 0
487 if(erup_end(i,j).le.0)cycle
488 ! if(emis_vol(i,kts,j,p_e_vash1).le.0.)cycle
489 !
490 ! erup_end is continuation in minutes
491 !
492 begday=int(erup_beg(i,j)/1000.)-1
493 beghr=int(erup_beg(i,j))-(begday+1)*1000
494 begmin=00.
495 endhr=beghr+int(erup_end(i,j)/60.)
496 endday=int(begday+endhr/24)-1
497 endmin=00.
498 ! write(0,*)'beghr,endhr = ',beghr,endhr,erup_beg(i,j),erup_end(i,j)
499 ! write(0,*)'begday,endday,julday = ',begday,endday,julday
500 ivolcano = 1
501 if(julday.le.begday .or. julday.ge.endday)then
502 ! write(0,*)'endhr,endmin,beghr,begmin = ',endhr,endmin,beghr,begmin
503 if( julday.lt.begday)then
504 write(message,'("before volcano stuff at julday = ",i8)') julday
505 call wrf_debug(15,message)
506 ivolcano=0
507 elseif(julday.eq.begday)then
508 if(beghr.gt.int(gmtp))then
509 write(message,'("before volcano stuff at gmtp = ",i8)') int(gmtp)
510 call wrf_debug(15,message)
511 ivolcano=0
512 elseif(beghr.eq.int(gmtp))then
513 if(begmin.gt.gmtm)then
514 write(message,'("before volcano stuff at gmtp,begmin = ",2i8)') int(gmtp),int(begmin)
515 call wrf_debug(15,message)
516 ivolcano=0
517 endif
518 endif
519 endif
520 if( julday.gt.endday)then
521 write(message,'("after volcano stuff at julday = ",i8)') julday
522 call wrf_debug(15,message)
523 ivolcano=0
524 elseif(julday.eq.endday)then
525 if(endhr.lt.int(gmtp))then
526 write(message,'("after volcano stuff at gmtp = ",i8)') int(gmtp)
527 call wrf_debug(15,message)
528 ivolcano=0
529 elseif(endhr.eq.int(gmtp))then
530 if(endmin.lt.gmtm)then
531 write(message,'("after volcano stuff at gmtm,endmin = ",2i8)') int(gmtm),int(endmin)
532 call wrf_debug(15,message)
533 ivolcano=0
534 endif
535 endif
536 endif
537 endif ! julday.ge.begday .and. julday.le.endday
539 volc_select: SELECT CASE(config_flags%chem_opt)
540 CASE (GOCART_SIMPLE,MOZCART_KPP,T1_MOZCART_KPP,GOCARTRADM2,GOCARTRACM_KPP)
541 CALL wrf_debug(15,'Adding volcanic emissions')
542 do k=kts,kte
543 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
544 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
545 +emis_vol(i,k,j,p_e_vso2)*conv
546 enddo
547 do k=kts,kte
548 conv=float(ivolcano)*alt(i,k,j)*dtstep/dz8w(i,k,j)
549 chem(i,k,j,p_p25)=chem(i,k,j,p_p25)+.5*emis_vol(i,k,j,p_e_vash10)*conv
550 chem(i,k,j,p_p10)=chem(i,k,j,p_p10) &
551 +.5*emis_vol(i,k,j,p_e_vash10)*conv &
552 +emis_vol(i,k,j,p_e_vash9)*conv &
553 +.5*emis_vol(i,k,j,p_e_vash8)*conv
554 enddo
555 CASE (RADM2SORG,RADM2SORG_AQ,RADM2SORG_KPP,RACMSORG_KPP,RACMSORG_AQ,RACM_ESRLSORG_KPP, &
556 RACMSORG_AQCHEM_KPP,RACM_ESRLSORG_AQCHEM_KPP)
557 ! write(0,*)'do later'
558 do k=kts,kte
559 conv = float(ivolcano)*4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
560 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
561 +emis_vol(i,k,j,p_e_vso2)*conv
562 ! aerosols for MADE/SORGAM
563 conv=alt(i,k,j)*dtstep/dz8w(i,k,j)
564 chem(i,k,j,p_p25i) = chem(i,k,j,p_p25i) &
565 +.25*emis_vol(i,k,j,p_e_vash10)*conv
566 chem(i,k,j,p_nu0) = chem(i,k,j,p_nu0) &
567 +.25*anthfac*factnumn*emis_vol(i,k,j,p_e_vash10)*conv
568 chem(i,k,j,p_ac0) = chem(i,k,j,p_ac0) &
569 +.75*anthfac*factnuma*emis_vol(i,k,j,p_e_vash10)*conv
570 chem(i,k,j,p_p25j) = chem(i,k,j,p_p25j) &
571 +.75*emis_vol(i,k,j,p_e_vash10)*conv
572 chem(i,k,j,p_antha) = chem(i,k,j,p_antha) &
573 +emis_vol(i,k,j,p_e_vash9)*conv ! &
574 ! +.5*emis_vol(i,k,j,p_e_vash8)*conv
575 chem(i,k,j,p_corn) = chem(i,k,j,p_corn) &
576 +anthfac*factnumc*emis_vol(i,k,j,p_e_vash9)*conv ! &
577 ! +anthfac*factnumc*.5*emis_vol(i,k,j,p_e_vash8)*conv
578 enddo
579 CASE (CHEM_VOLC)
580 CALL wrf_debug(15,'Adding volcanic emissions to case chem_volc')
581 do k=kts,kte
582 conv = float(ivolcano)*4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
583 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
584 +emis_vol(i,k,j,p_e_vso2)*conv
585 enddo
586 do k=kts,kte
587 conv=float(ivolcano)*alt(i,k,j)*dtstep/dz8w(i,k,j)
588 chem(i,k,j,p_vash_1)=chem(i,k,j,p_vash_1)+emis_vol(i,k,j,p_e_vash1)*conv
589 chem(i,k,j,p_vash_2)=chem(i,k,j,p_vash_2)+emis_vol(i,k,j,p_e_vash2)*conv
590 chem(i,k,j,p_vash_3)=chem(i,k,j,p_vash_3)+emis_vol(i,k,j,p_e_vash3)*conv
591 chem(i,k,j,p_vash_4)=chem(i,k,j,p_vash_4)+emis_vol(i,k,j,p_e_vash4)*conv
592 chem(i,k,j,p_vash_5)=chem(i,k,j,p_vash_5)+emis_vol(i,k,j,p_e_vash5)*conv
593 chem(i,k,j,p_vash_6)=chem(i,k,j,p_vash_6)+emis_vol(i,k,j,p_e_vash6)*conv
594 chem(i,k,j,p_vash_7)=chem(i,k,j,p_vash_7)+emis_vol(i,k,j,p_e_vash7)*conv
595 chem(i,k,j,p_vash_8)=chem(i,k,j,p_vash_8)+emis_vol(i,k,j,p_e_vash8)*conv
596 chem(i,k,j,p_vash_9)=chem(i,k,j,p_vash_9)+emis_vol(i,k,j,p_e_vash9)*conv
597 chem(i,k,j,p_vash_10)=chem(i,k,j,p_vash_10)+emis_vol(i,k,j,p_e_vash10)*conv
598 enddo
599 CASE (CHEM_VOLC_4BIN)
600 CALL wrf_debug(15,'Adding volcanic emissions to case chem_volc_4bin')
601 do k=kts,kte
602 conv=float(ivolcano)*alt(i,k,j)*dtstep/dz8w(i,k,j)
603 chem(i,k,j,p_vash_7)=chem(i,k,j,p_vash_7)+emis_vol(i,k,j,p_e_vash7)*conv
604 chem(i,k,j,p_vash_8)=chem(i,k,j,p_vash_8)+emis_vol(i,k,j,p_e_vash8)*conv
605 chem(i,k,j,p_vash_9)=chem(i,k,j,p_vash_9)+emis_vol(i,k,j,p_e_vash9)*conv
606 chem(i,k,j,p_vash_10)=chem(i,k,j,p_vash_10)+emis_vol(i,k,j,p_e_vash10)*conv
607 enddo
608 CASE (CHEM_VASH)
609 CALL wrf_debug(15,'Adding volcanic emissions to case chem_volc')
610 do k=kts,kte
611 conv=float(ivolcano)*alt(i,k,j)*dtstep/dz8w(i,k,j)
612 chem(i,k,j,p_vash_1)=chem(i,k,j,p_vash_1)+emis_vol(i,k,j,p_e_vash1)*conv
613 chem(i,k,j,p_vash_2)=chem(i,k,j,p_vash_2)+emis_vol(i,k,j,p_e_vash2)*conv
614 chem(i,k,j,p_vash_3)=chem(i,k,j,p_vash_3)+emis_vol(i,k,j,p_e_vash3)*conv
615 chem(i,k,j,p_vash_4)=chem(i,k,j,p_vash_4)+emis_vol(i,k,j,p_e_vash4)*conv
616 chem(i,k,j,p_vash_5)=chem(i,k,j,p_vash_5)+emis_vol(i,k,j,p_e_vash5)*conv
617 chem(i,k,j,p_vash_6)=chem(i,k,j,p_vash_6)+emis_vol(i,k,j,p_e_vash6)*conv
618 chem(i,k,j,p_vash_7)=chem(i,k,j,p_vash_7)+emis_vol(i,k,j,p_e_vash7)*conv
619 chem(i,k,j,p_vash_8)=chem(i,k,j,p_vash_8)+emis_vol(i,k,j,p_e_vash8)*conv
620 chem(i,k,j,p_vash_9)=chem(i,k,j,p_vash_9)+emis_vol(i,k,j,p_e_vash9)*conv
621 chem(i,k,j,p_vash_10)=chem(i,k,j,p_vash_10)+emis_vol(i,k,j,p_e_vash10)*conv
622 enddo
623 CASE DEFAULT
624 END SELECT volc_select
625 !!!!!!
626 enddo
627 enddo
628 ENDIF! config_flags%emiss_opt_vol == 1 .or. config_flags%emiss_opt_vol == 2
629 !--------------------------------------------------------------------------------------
630 do_plumerisefire = .false.
631 IF ( config_flags%biomass_burn_opt == BIOMASSB_MOZC .OR. &
632 config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART .OR. &
633 config_flags%biomass_burn_opt == BIOMASSB_MOZ .OR. &
634 config_flags%biomass_burn_opt == BIOMASSB_GHG .OR. &
635 config_flags%biomass_burn_opt == BIOMASSB ) then
636 IF ( ktau==1 ) then
637 do_plumerisefire = .true.
638 ELSE IF ( adapt_step_flag ) THEN
639 IF ( (plumerisefire_frq<=0) .or. &
640 ( curr_secs+real(dtstep,8)+0.01 >= &
641 ( INT( curr_secs/real(plumerisefire_frq*60.,8)+1,8 )*real(plumerisefire_frq*60.,8) ) ) &
642 ) then
643 do_plumerisefire = .true.
644 ENDIF
645 ELSE IF ( (MOD(ktau,stepfirepl)==0) .or. (stepfirepl==1) ) THEN
646 do_plumerisefire = .true.
647 ENDIF
648 ENDIF
650 do_bioemiss = .false.
651 IF ( ktau==1 ) then
652 do_bioemiss = .true.
653 ELSE IF ( adapt_step_flag ) THEN
654 IF ( (bioemdt<=0) .or. &
655 ( curr_secs+real(dtstep,8)+0.01 >= &
656 ( INT( curr_secs/real(bioemdt*60.,8)+1,8 )*real(bioemdt*60.,8) ) ) &
657 ) then
658 do_bioemiss = .true.
659 ENDIF
660 ELSE IF ( (MOD(ktau,stepbioe)==0) .or. (stepbioe==1) ) THEN
661 do_bioemiss = .true.
662 ENDIF
663 !
664 ! we are doing the plumerise/fire emissions first, they may be needed for chem and tracer arrays
665 !
666 if( do_plumerisefire )then
667 CALL wrf_debug(15,'fire emissions: calling biomassb')
668 write(0,*)ktau,stepfirepl
669 call plumerise_driver (id,ktau,dtstep, &
670 ebu,ebu_in, &
671 mean_fct_agtf,mean_fct_agef,mean_fct_agsv,mean_fct_aggr, &
672 firesize_agtf,firesize_agef,firesize_agsv,firesize_aggr, &
673 config_flags, t_phy,moist, &
674 rho_phy,vvel,u_phy,v_phy,p_phy, &
675 emis_ant,z_at_w,z,config_flags%scale_fire_emiss, &
676 ids,ide, jds,jde, kds,kde, &
677 ims,ime, jms,jme, kms,kme, &
678 its,ite, jts,jte, kts,kte )
679 endif
680 !
681 ! Only Scalar?
682 !
683 tracer_select: SELECT CASE(config_flags%tracer_opt)
684 CASE (TRACER_SMOKE,TRACER_TEST2)
685 CALL wrf_debug(15,'tracer fire emissions: calling biomassb, only CO')
686 !
687 ! here for tracers only, set chem_opt to zero. Chem species are handled later!
688 !
689 call add_emis_burn(id,dtstep,ktau,dz8w,rho_phy,tracer,&
690 julday,gmt,xlat,xlong,t_phy,p_phy, &
691 ebu,0,config_flags%tracer_opt,config_flags%biomass_burn_opt, &
692 num_tracer,ids,ide, jds,jde, kds,kde, &
693 ims,ime, jms,jme, kms,kme, &
694 its,ite, jts,jte, kts,kte )
695 CASE DEFAULT
696 CALL wrf_debug(15,'No tracer option selected')
697 END SELECT tracer_select
699 !
700 ! Gocart emissions...
701 !
702 seasalt_select: SELECT CASE(config_flags%seas_opt)
703 CASE (SEASGOCART)
704 CALL wrf_debug(15,'Gocart sea salt emissions')
705 call gocart_seasalt_driver(ktau,dtstep,config_flags,julday,alt,t_phy,moist,u_phy, &
706 v_phy,chem,rho_phy,dz8w,u10,v10,p8w,z_at_w, &
707 xland,xlat,xlong,dx,g,emis_seas, seasin,&
708 ids,ide, jds,jde, kds,kde, &
709 ims,ime, jms,jme, kms,kme, &
710 its,ite, jts,jte, kts,kte )
712 CASE DEFAULT
713 if(seasalt_emiss_active.eq.1) then
714 CALL wrf_debug(15,'MOSAIC or SORGAM sea salt emissions')
715 elseif(seasalt_emiss_active.eq.3) then
716 CALL wrf_debug(15,'MOSAIC sea salt emissions (Fuentes et al) - low activity')
717 elseif(seasalt_emiss_active.eq.4) then
718 CALL wrf_debug(15,'MOSAIC sea salt emissions (Fuentes et al) - high activity')
719 else
720 CALL wrf_debug(15,'no sea salt emissions')
721 end if
722 END SELECT seasalt_select
724 dust_select: SELECT CASE(config_flags%dust_opt)
725 CASE (DUSTGOCART)
726 CALL wrf_debug(15,'Gocart dust emissions')
727 call gocart_dust_driver(dtstep,config_flags,alt,t_phy,u_phy, &
728 v_phy,chem,rho_phy,dz8w,smois,u10,v10,erod,dustin, &
729 isltyp,xland,g,emis_dust, &
730 ids,ide, jds,jde, kds,kde, &
731 ims,ime, jms,jme, kms,kme, &
732 its,ite, jts,jte, kts,kte )
733 CASE (DUSTGOCARTAFWA)
734 CALL wrf_debug(15,'AFWA modified Gocart dust emissions')
735 call gocart_dust_afwa_driver(dtstep,config_flags,alt, &
736 chem,rho_phy,smois,u10,v10,dz8w,erod,erod_dri,dustin,snowh, &
737 isltyp,vegfra,lai_vegmask,xland,g,emis_dust, &
738 ust,znt,clayfrac,sandfrac,clayfrac_nga,sandfrac_nga,afwa_dustloft,&!EDH
739 tot_dust,tot_edust,vis_dust,dust_alpha,dust_gamma,dust_smtune,dust_ustune, &
740 ids,ide, jds,jde, kds,kde, &
741 ims,ime, jms,jme, kms,kme, &
742 its,ite, jts,jte, kts,kte )
743 CASE (DUSTUOC)
744 CALL wrf_debug(15,'UoC dust emission schemes')
745 ! kang [2008/12/14] modify for namelist selection
746 scheme_select: SELECT CASE(config_flags%dust_schme)
747 CASE (SHAO_2001)
748 imod = 1
749 CASE (SHAO_2004)
750 imod = 2
751 CASE (SHAO_2011)
752 imod = 3
753 CASE DEFAULT
754 imod = 2
755 END SELECT scheme_select
756 call uoc_dust_driver (dtstep,config_flags, &
757 chem,rho_phy,dz8w,smois,ust, isltyp,vegfra,g,emis_dust, &
758 ust_t, imod, rough_cor, smois_cor, soil_top_cat, erod, &
759 ids,ide, jds,jde, kds,kde, &
760 ims,ime, jms,jme, kms,kme, &
761 its,ite, jts,jte, kts,kte )
762 CASE DEFAULT
763 if(dust_emiss_active.eq.1) then
764 CALL wrf_debug(15,'MOSAIC or SORGAM dust emissions')
765 else
766 CALL wrf_debug(15,'no dust emissions')
767 end if
768 END SELECT dust_select
770 dms_select: SELECT CASE(config_flags%dmsemis_opt)
771 CASE (DMSGOCART)
772 CALL wrf_debug(15,'Gocart dms emissions')
773 call gocart_dmsemis(dtstep,config_flags,alt,t_phy,u_phy, &
774 v_phy,chem,rho_phy,dz8w,u10,v10,p8w,dms_0,tsk, &
775 ivgtyp,isltyp,xland,dx,g, &
776 ids,ide, jds,jde, kds,kde, &
777 ims,ime, jms,jme, kms,kme, &
778 its,ite, jts,jte, kts,kte )
779 CASE DEFAULT
780 CALL wrf_debug(15,'no dms emissions')
781 END SELECT dms_select
783 ksub=0
784 !!! *********** FIRE AND CHEM ****************************************
785 !
786 fire_select: SELECT CASE(config_flags%biomass_burn_opt)
787 CASE (BIOMASSB,BIOMASSB_MOZC,BIOMASSB_MOZ,BIOMASSB_T1_MOZCART,BIOMASSB_GHG)
788 ! if( do_plumerisefire )then
789 ! CALL wrf_debug(15,'fire emissions: calling biomassb')
790 ! write(0,*)ktau,stepfirepl
791 ! call plumerise_driver (id,ktau,dtstep, &
792 ! ebu,ebu_in, &
793 ! mean_fct_agtf,mean_fct_agef,mean_fct_agsv,mean_fct_aggr, &
794 ! firesize_agtf,firesize_agef,firesize_agsv,firesize_aggr, &
795 ! config_flags, t_phy,moist, &
796 ! chem,rho_phy,vvel,u_phy,v_phy,p_phy, &
797 ! emis_ant,z_at_w,z, &
798 ! ids,ide, jds,jde, kds,kde, &
799 ! ims,ime, jms,jme, kms,kme, &
800 ! its,ite, jts,jte, kts,kte )
802 ! endif
803 CALL wrf_debug(15,'fire emissions: adding biomassb emissions')
804 call add_emis_burn(id,dtstep,ktau,dz8w,rho_phy,chem,&
805 julday,gmt,xlat,xlong,t_phy,p_phy, &
806 ebu,config_flags%chem_opt,0,config_flags%biomass_burn_opt, &
807 num_chem,ids,ide, jds,jde, kds,kde, &
808 ims,ime, jms,jme, kms,kme, &
809 its,ite, jts,jte, kts,kte )
810 CASE DEFAULT
811 CALL wrf_debug(15,'no biomass burning')
812 END SELECT fire_select
813 !!**************** END FIRE, BEGIN BIOGENIC EMISSIONS
814 !
815 bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
816 CASE (GUNTHER1)
817 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
818 CALL wrf_debug(15,'biogenic emissions: calling Gunther1')
819 call bio_emissions(id,ktau,dtstep,DX,config_flags, &
820 gmt,julday,t_phy,moist,p8w,t8w, &
821 e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
822 ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w, &
823 ids,ide, jds,jde, kds,kde, &
824 ims,ime, jms,jme, kms,kme, &
825 its,ite, jts,jte, kts,kte )
826 endif
827 CASE (BEIS314)
828 if( do_bioemiss ) then
829 beis314_check_mechanism_ok: SELECT CASE(config_flags%chem_opt)
830 CASE (RADM2, RADM2_KPP, RADM2SORG, RADM2SORG_AQ, RADM2SORG_AQCHEM, RADM2SORG_KPP, &
831 RACM_KPP, RACMPM_KPP, RACM_MIM_KPP, RACMSORG_AQ,RACMSORG_AQCHEM_KPP, &
832 RACM_ESRLSORG_AQCHEM_KPP, RACMSORG_KPP,RACM_ESRLSORG_KPP, RACM_SOA_VBS_KPP, &
833 RACM_SOA_VBS_AQCHEM_KPP, RACM_SOA_VBS_HET_KPP, CBM4_KPP, NMHC9_KPP, GOCARTRACM_KPP,GOCARTRADM2)
834 CASE DEFAULT
835 CALL wrf_error_fatal( &
836 "emissions_driver: beis3.1.4 biogenic emis. implemented for RADM2 & RACM only")
837 END SELECT beis314_check_mechanism_ok
838 CALL wrf_debug(15,'biogenic emissions: calling beis3.1.4')
839 call bio_emissions_beis314(id,config_flags,ktau,curr_secs, &
840 dtstep,julday,gmt,xlat,xlong,t_phy,p_phy,gsw, &
841 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
842 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
843 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
844 sebio_sesq,sebio_mbo, &
845 noag_grow,noag_nongrow,nononag,slai, &
846 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
847 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
848 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
849 ebio_sesq,ebio_mbo, &
850 ids,ide, jds,jde, kds,kde, &
851 ims,ime, jms,jme, kms,kme, &
852 its,ite, jts,jte, kts,kte )
853 endif
855 CASE (MEGAN2)
856 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
857 CALL wrf_debug(15,'biogenic emissions: calling megan v2.04')
858 call bio_emissions_megan2(id,config_flags,ktau,dtstep, &
859 curr_secs,julday,gmt,xlat,xlong,p_phy,rho_phy,dz8w, &
860 chem,ne_area, &
861 current_month, &
862 T2,swdown, &
863 nmegan, EFmegan, msebio_isop, &
864 mlai, &
865 pftp_bt, pftp_nt, pftp_sb, pftp_hb, &
866 mtsa, &
867 mswdown, &
868 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
869 mebio_acet, mebio_mbo, mebio_no, &
870 ebio_iso,ebio_oli,ebio_api,ebio_lim, &
871 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
872 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_no, &
873 ebio_c10h16,ebio_tol,ebio_bigalk, ebio_ch3oh,ebio_acet, &
874 ebio_nh3,ebio_no2,ebio_c2h5oh,ebio_ch3cooh,ebio_mek, &
875 ebio_bigene,ebio_c2h6,ebio_c2h4,ebio_c3h6,ebio_c3h8,ebio_so2, &
876 ebio_dms,ebio_hcn, &
877 ebio_c5h8,ebio_apinene,ebio_bpinene,ebio_toluene, &
878 ebio_ch3cho,ebio_ch3co2h,ebio_tbut2ene,ebio_c2h5cho, &
879 ebio_nc4h10, &
880 ebio_sesq, ebio_mbo,ebio_bpi,ebio_myrc, &
881 ebio_alk3, ebio_alk4, ebio_alk5, ebio_ole1, ebio_ole2, &
882 ebio_aro1, ebio_aro2, ebio_ccho, ebio_meoh, &
883 ebio_ethene, ebio_hcooh, ebio_terp, ebio_bald, &
884 ebio_cco_oh, ebio_rco_oh, &
885 e_bio, &
886 ids,ide, jds,jde, kds,kde, &
887 ims,ime, jms,jme, kms,kme, &
888 its,ite, jts,jte, kts,kte )
889 endif
890 #if( WRF_USE_CLM == 1)
891 CASE (MEGAN2_CLM)
892 !...conversion factor from ppm m min-1 to mol km-2 hr-1
893 !...(e_bio is in units of ppm m min-1)
894 convert2(its:ite,jts:jte) = rho_phy(its:ite,kts,jts:jte)*60./.02897
895 do m = 1,shr_megan_mechcomps_n
896 p_in_chem = shr_megan_mechcomps(m)%index
897 IF ( p_in_chem+1 == p_isoprene ) THEN
898 ebio_iso(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
899 ELSEIF ( p_in_chem+1 == p_no ) THEN
900 ebio_no(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
901 ELSEIF ( p_in_chem+1 == p_no2 ) THEN
902 ebio_no2(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
903 ELSEIF ( p_in_chem+1 == p_co ) THEN
904 ebio_co(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
905 ELSEIF ( p_in_chem+1 == p_hcho ) THEN
906 ebio_hcho(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
907 ELSEIF ( p_in_chem+1 == p_ald ) THEN
908 ebio_ald(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
909 ELSEIF ( p_in_chem+1 == p_acet ) THEN
910 ebio_acet(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
911 ELSEIF ( p_in_chem+1 == p_tol ) THEN
912 ebio_tol(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
913 ELSEIF ( p_in_chem+1 == p_c10h16 ) THEN
914 ebio_c10h16(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
915 ELSEIF ( p_in_chem+1 == p_so2 ) THEN
916 ebio_so2(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
917 ELSEIF ( p_in_chem+1 == p_dms ) THEN
918 ebio_dms(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
919 ELSEIF ( p_in_chem+1 == p_bigalk ) THEN
920 ebio_bigalk(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
921 ELSEIF ( p_in_chem+1 == p_bigene ) THEN
922 ebio_bigene(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
923 ELSEIF ( p_in_chem+1 == p_nh3 ) THEN
924 ebio_nh3(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
925 ELSEIF ( p_in_chem+1 == p_ch3oh ) THEN
926 ebio_ch3oh(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
927 ELSEIF ( p_in_chem+1 == p_c2h5oh ) THEN
928 ebio_c2h5oh(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
929 ELSEIF ( p_in_chem+1 == p_ch3co2h ) THEN
930 ebio_ch3cooh(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
931 ELSEIF ( p_in_chem+1 == p_mek ) THEN
932 ebio_mek(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
933 ELSEIF ( p_in_chem+1 == p_c2h4 ) THEN
934 ebio_c2h4(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
935 ELSEIF ( p_in_chem+1 == p_c2h6 ) THEN
936 ebio_c2h6(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
937 ELSEIF ( p_in_chem+1 == p_c3h6 ) THEN
938 ebio_c3h6(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
939 ELSEIF ( p_in_chem+1 == p_c3h8 ) THEN
940 ebio_c3h8(its:ite,jts:jte) = e_bio(its:ite,jts:jte,p_in_chem)*convert2(its:ite,jts:jte)
941 ENDIF
942 end do
943 #endif
945 CASE DEFAULT
946 if( do_bioemiss ) &
947 e_bio(its:ite,jts:jte,1:ne_area) = 0.
948 !wig: May need to zero out all ebio_xxx arrays too if they are incorporated
949 ! into CBMZ/MOSAIC.
951 END SELECT bioem_select
953 !!! **************** END BIOGENICS, ADD EMISSIONS FOR VARIOUS PACKAGES
954 !
955 gas_addemiss_select: SELECT CASE(config_flags%chem_opt)
956 CASE (RADM2, RADM2_KPP, RADM2SORG, RADM2SORG_AQ, RADM2SORG_AQCHEM, RADM2SORG_KPP, &
957 RACM_KPP, RACMPM_KPP, RACM_MIM_KPP, RACMSORG_AQ, RACMSORG_AQCHEM_KPP, RACM_ESRLSORG_AQCHEM_KPP, RACMSORG_KPP, &
958 RACM_SOA_VBS_KPP, RACM_SOA_VBS_AQCHEM_KPP, RACM_SOA_VBS_HET_KPP, RACM_ESRLSORG_KPP, MOZART_KPP, MOZCART_KPP, &
959 T1_MOZCART_KPP, MOZART_MOSAIC_4BIN_KPP, MOZART_MOSAIC_4BIN_AQ_KPP, &
960 CRIMECH_KPP, CRI_MOSAIC_8BIN_AQ_KPP, CRI_MOSAIC_4BIN_AQ_KPP )
961 IF(config_flags%emiss_inpt_opt /= 3 ) then
962 IF(config_flags%kemit .GT. kte-ksub) THEN
963 k=config_flags%kemit
964 write(message,'(" WARNING: EMISSIONS_DRIVER: KEMIT > KTE ",3i6)') kme,kte-ksub,k
965 CALL WRF_MESSAGE (message)
966 ENDIF
967 call wrf_debug(15,'emissions_driver calling add_anthropogenics')
968 call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,alt, &
969 chem, emis_ant,emis_aircraft, &
970 ids,ide, jds,jde, kds,kde, &
971 ims,ime, jms,jme, kms,kme, &
972 its,ite, jts,jte, kts,kte )
973 call wrf_debug(15,'emissions_driver calling add_biogenics')
974 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
975 e_bio,ne_area, &
976 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
977 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
978 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
979 ebio_sesq,ebio_mbo, &
980 ids,ide, jds,jde, kds,kde, &
981 ims,ime, jms,jme, kms,kme, &
982 its,ite, jts,jte, kts,kte )
984 end if ! emiss_inpt_opt /= 3
987 !For SAPRC99 need to define SAPRC99_addemiss_anthro and SAPRC99_addemiss_bio
988 !so did not add saprcnov packages here
989 CASE (CBMZ, CBMZ_BB, CBMZ_BB_KPP, CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, &
990 CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ, &
991 CBMZSORG, CBMZSORG_AQ, CBMZ_MOSAIC_DMS_4BIN, CBMZ_MOSAIC_DMS_8BIN, &
992 CBMZ_MOSAIC_KPP, &
993 CBMZ_MOSAIC_DMS_4BIN_AQ, CBMZ_MOSAIC_DMS_8BIN_AQ, &
994 CBMZ_CAM_MAM3_NOAQ, CBMZ_CAM_MAM3_AQ, CBMZ_CAM_MAM7_NOAQ, CBMZ_CAM_MAM7_AQ)
995 IF(config_flags%kemit .GT. kte-ksub) THEN
996 message = ' EMISSIONS_DRIVER: KEMIT > KME '
997 CALL WRF_ERROR_FATAL (message)
998 ENDIF
999 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_anthro')
1000 call cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags, &
1001 rho_phy, chem, &
1002 emis_ant,alt,ids,ide, jds,jde, kds,kde, &
1003 ims,ime, jms,jme, kms,kme, &
1004 its,ite, jts,jte, kts,kte )
1005 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_bio')
1006 !BSINGH: 03/13/2013
1007 !Commented out (or delete??) the following call to "cbmz_addemiss_bio"and
1008 !replaced with an "add_biogenic" call to make it consistent
1009 !with other packages
1010 !call cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
1011 ! rho_phy, chem, e_bio, ne_area, emis_ant(ims,kms,jms,p_e_iso),&
1012 ! ids,ide, jds,jde, kds,kde, &
1013 ! ims,ime, jms,jme, kms,kme, &
1014 ! its,ite, jts,jte, kts,kte )
1016 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
1017 e_bio,ne_area, &
1018 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
1019 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
1020 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
1021 ebio_sesq,ebio_mbo, &
1022 ids,ide, jds,jde, kds,kde, &
1023 ims,ime, jms,jme, kms,kme, &
1024 its,ite, jts,jte, kts,kte )
1026 CASE (CB05_SORG_AQ_KPP, CB05_SORG_VBS_AQ_KPP)
1027 IF(config_flags%kemit .GT. kte-ksub) THEN
1028 message = ' EMISSIONS_DRIVER: KEMIT > KME '
1029 CALL WRF_ERROR_FATAL (message)
1030 ENDIF
1031 call wrf_debug(15,'emissions_driver calling cb05_addemiss_anthro')
1032 call cb05_addemiss_anthro( id, dtstep, dz8w, config_flags, &
1033 rho_phy, chem, &
1034 emis_ant,ids,ide, jds,jde, kds,kde, &
1035 ims,ime, jms,jme, kms,kme, &
1036 its,ite, jts,jte, kts,kte )
1037 call wrf_debug(15,'emissions_driver calling cb05_addemiss_bio')
1038 ! fixed a bug related to CB05 MEGAN mapping by KW 03/20/2017
1039 if (config_flags%bio_emiss_opt .ne. 0 .and. &
1040 config_flags%bio_emiss_opt .ne. GUNTHER1) then
1041 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
1042 e_bio,ne_area, &
1043 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
1044 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
1045 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
1046 ebio_sesq,ebio_mbo, &
1047 ids,ide, jds,jde, kds,kde, &
1048 ims,ime, jms,jme, kms,kme, &
1049 its,ite, jts,jte, kts,kte )
1050 endif
1052 if ( config_flags%bio_emiss_opt .eq. GUNTHER1 ) then
1053 call cb05_addemiss_bio( id, dtstep, dz8w, config_flags, &
1054 rho_phy, chem, e_bio, ne_area, emis_ant(ims,kms,jms,p_e_iso),&
1055 ids,ide, jds,jde, kds,kde, &
1056 ims,ime, jms,jme, kms,kme, &
1057 its,ite, jts,jte, kts,kte )
1058 endif
1060 CASE (CHEM_TRACER)
1061 do j=jts,jte
1062 do i=its,ite
1063 do k=kts,min(config_flags%kemit,kte-ksub)
1064 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1065 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1066 +emis_ant(i,k,j,p_e_so2)*conv
1067 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
1068 +emis_ant(i,k,j,p_e_co)*conv
1069 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
1070 +emis_ant(i,k,j,p_e_co)*conv
1071 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
1072 +emis_ant(i,k,j,p_e_co)*conv
1073 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
1074 +emis_ant(i,k,j,p_e_co)*conv
1075 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
1076 +emis_ant(i,k,j,p_e_co)*conv
1077 end do
1078 end do
1079 end do
1080 !
1081 CASE(CO2_TRACER,GHG_TRACER) ! for ghg_tracer package
1083 ! Update the biospheric CO2 fluxes
1084 CALL VPRM( ids,ide, jds,jde, &
1085 ims,ime, jms,jme, &
1086 its,ite, jts,jte, &
1088 vprm_in,rad_vprm,lambda_vprm, &
1089 alpha_vprm,resp_vprm, &
1090 T2,swdown, &
1091 eghg_bio )
1093 ! Update the biospheric CH4 fluxes if the GHG option is called
1094 if (p_ch4_bio .GT. 1) then
1096 CALL KAPLAN( ids,ide, jds,jde, &
1097 ims,ime, jms,jme, &
1098 its,ite, jts,jte, &
1100 xtime, tslb, smois, wet_in, &
1101 isltyp,tsk,eghg_bio, &
1102 config_flags%num_soil_layers,config_flags%wpeat, &
1103 config_flags%wflood )
1105 CALL SOILUPTAKE( ids,ide, jds,jde, &
1106 ims,ime, jms,jme, &
1107 its,ite, jts,jte, &
1109 smois, isltyp, eghg_bio, &
1110 rainc, rainnc, &
1111 potevp, sfcevp, lu_index, T2, xtime, &
1112 config_flags%num_soil_layers, wet_in )
1114 CALL termite( ids,ide, jds,jde, &
1115 ims,ime, jms,jme, &
1116 its,ite, jts,jte, &
1118 xtime,eghg_bio,ivgtyp, &
1119 biomt_par,emit_par )
1121 end if
1123 ! Add all the GHG fluxes to chem species, this step is for both
1124 ! anthropogenic and biospheric fluxes
1125 IF (config_flags%emiss_inpt_opt==16) THEN
1126 CALL add_ghg_fluxes( ids,ide, jds,jde, kds,kde, &
1127 ims,ime, jms,jme, kms,kme, &
1128 its,ite, jts,jte, kts,kte, &
1130 dtstep,dz8w,config_flags,rho_phy, &
1131 chem,emis_ant,eghg_bio,ebio_co2oce )
1132 END IF
1133 !**************************************************************************************************
1134 CASE (SAPRC99_KPP) !FIX FOR SAPRC07A
1135 if(config_flags%emiss_opt == 13 ) then
1136 do j=jts,jte
1137 do i=its,ite
1138 do k=kts,min(config_flags%kemit,kte-ksub)
1139 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1140 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1141 +emis_ant(i,k,j,p_e_so2)*conv
1142 chem(i,k,j,p_c2h6) = chem(i,k,j,p_c2h6) &
1143 +emis_ant(i,k,j,p_e_c2h6)*conv
1144 chem(i,k,j,p_c3h8) = chem(i,k,j,p_c3h8) &
1145 +emis_ant(i,k,j,p_e_c3h8)*conv
1146 chem(i,k,j,p_c2h2) = chem(i,k,j,p_c2h2) &
1147 +emis_ant(i,k,j,p_e_c2h2)*conv
1148 chem(i,k,j,p_alk3) = chem(i,k,j,p_alk3) &
1149 +emis_ant(i,k,j,p_e_alk3)*conv
1150 chem(i,k,j,p_alk4) = chem(i,k,j,p_alk4) &
1151 +emis_ant(i,k,j,p_e_alk4)*conv
1152 chem(i,k,j,p_alk5) = chem(i,k,j,p_alk5) &
1153 +emis_ant(i,k,j,p_e_alk5)*conv
1154 chem(i,k,j,p_ethene) = chem(i,k,j,p_ethene) &
1155 +emis_ant(i,k,j,p_e_ethene)*conv
1156 chem(i,k,j,p_c3h6) = chem(i,k,j,p_c3h6) &
1157 +emis_ant(i,k,j,p_e_c3h6)*conv
1158 chem(i,k,j,p_ole1) = chem(i,k,j,p_ole1) &
1159 +emis_ant(i,k,j,p_e_ole1)*conv
1160 chem(i,k,j,p_ole2) = chem(i,k,j,p_ole2) &
1161 +emis_ant(i,k,j,p_e_ole2)*conv
1162 chem(i,k,j,p_aro1) = chem(i,k,j,p_aro1) &
1163 +emis_ant(i,k,j,p_e_aro1)*conv
1164 chem(i,k,j,p_aro2) = chem(i,k,j,p_aro2) &
1165 +emis_ant(i,k,j,p_e_aro2)*conv
1166 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
1167 +emis_ant(i,k,j,p_e_hcho)*conv
1168 chem(i,k,j,p_ccho) = chem(i,k,j,p_ccho) &
1169 +emis_ant(i,k,j,p_e_ccho)*conv
1170 chem(i,k,j,p_rcho) = chem(i,k,j,p_rcho) &
1171 +emis_ant(i,k,j,p_e_rcho)*conv
1172 chem(i,k,j,p_acet) = chem(i,k,j,p_acet) &
1173 +emis_ant(i,k,j,p_e_acet)*conv
1174 chem(i,k,j,p_mek) = chem(i,k,j,p_mek) &
1175 +emis_ant(i,k,j,p_e_mek)*conv
1176 chem(i,k,j,p_isoprene) = chem(i,k,j,p_isoprene) &
1177 +emis_ant(i,k,j,p_e_isoprene)*conv
1178 chem(i,k,j,p_terp) = chem(i,k,j,p_terp) &
1179 +emis_ant(i,k,j,p_e_terp)*conv
1180 chem(i,k,j,p_sesq) = chem(i,k,j,p_sesq) &
1181 +emis_ant(i,k,j,p_e_sesq)*conv
1182 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
1183 +emis_ant(i,k,j,p_e_co)*conv
1184 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
1185 +emis_ant(i,k,j,p_e_no)*conv
1186 chem(i,k,j,p_no2) = chem(i,k,j,p_no2) &
1187 +emis_ant(i,k,j,p_e_no2)*conv
1188 chem(i,k,j,p_phen) = chem(i,k,j,p_phen) &
1189 +emis_ant(i,k,j,p_e_phen)*conv
1190 chem(i,k,j,p_cres) = chem(i,k,j,p_cres) &
1191 +emis_ant(i,k,j,p_e_cres)*conv
1192 chem(i,k,j,p_meoh) = chem(i,k,j,p_meoh) &
1193 +emis_ant(i,k,j,p_e_meoh)*conv
1194 chem(i,k,j,p_gly) = chem(i,k,j,p_gly) &
1195 +emis_ant(i,k,j,p_e_gly)*conv
1196 chem(i,k,j,p_mgly) = chem(i,k,j,p_mgly) &
1197 +emis_ant(i,k,j,p_e_mgly)*conv
1198 chem(i,k,j,p_bacl) = chem(i,k,j,p_bacl) &
1199 +emis_ant(i,k,j,p_e_bacl)*conv
1200 chem(i,k,j,p_isoprod) = chem(i,k,j,p_isoprod) &
1201 +emis_ant(i,k,j,p_e_isoprod)*conv
1202 chem(i,k,j,p_methacro) = chem(i,k,j,p_methacro) &
1203 +emis_ant(i,k,j,p_e_methacro)*conv
1204 chem(i,k,j,p_mvk) = chem(i,k,j,p_mvk) &
1205 +emis_ant(i,k,j,p_e_mvk)*conv
1206 chem(i,k,j,p_prod2) = chem(i,k,j,p_prod2) &
1207 +emis_ant(i,k,j,p_e_prod2)*conv
1208 chem(i,k,j,p_ch4) = chem(i,k,j,p_ch4) &
1209 +emis_ant(i,k,j,p_e_ch4)*conv
1210 chem(i,k,j,p_bald) = chem(i,k,j,p_bald) &
1211 +emis_ant(i,k,j,p_e_bald)*conv
1212 chem(i,k,j,p_hcooh) = chem(i,k,j,p_hcooh) &
1213 +emis_ant(i,k,j,p_e_hcooh)*conv
1214 chem(i,k,j,p_cco_oh) = chem(i,k,j,p_cco_oh) &
1215 +emis_ant(i,k,j,p_e_cco_oh)*conv
1216 chem(i,k,j,p_rco_oh) = chem(i,k,j,p_rco_oh) &
1217 +emis_ant(i,k,j,p_e_rco_oh)*conv
1219 end do
1220 end do
1221 end do
1222 else
1223 do j=jts,jte
1224 do i=its,ite
1225 do k=kts,min(config_flags%kemit,kte-ksub)
1226 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1227 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1228 +emis_ant(i,k,j,p_e_so2)*conv
1229 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
1230 +emis_ant(i,k,j,p_e_co)*conv
1231 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
1232 +emis_ant(i,k,j,p_e_no)*conv
1233 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
1234 +emis_ant(i,k,j,p_e_hcho)*conv
1235 end do
1236 end do
1237 end do
1238 endif
1240 !BSINGH - Adding add_biogenics call
1241 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
1242 e_bio,ne_area, &
1243 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
1244 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
1245 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
1246 ebio_sesq,ebio_mbo, &
1247 ids,ide, jds,jde, kds,kde, &
1248 ims,ime, jms,jme, kms,kme, &
1249 its,ite, jts,jte, kts,kte )
1251 CASE (SAPRC99_MOSAIC_4BIN_VBS2_KPP, SAPRC99_MOSAIC_8BIN_VBS2_AQ_KPP, &
1252 SAPRC99_MOSAIC_8BIN_VBS2_KPP) !FIX FOR SAPRC07A!BSINGH(12/11/2013): Added SAPRC 8 bin
1253 if(config_flags%emiss_opt == 13 ) then
1254 do j=jts,jte
1255 do i=its,ite
1256 do k=kts,min(config_flags%kemit,kte-ksub)
1257 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1258 conv3 = (dtstep/dz8w(i,k,j))*alt(i,k,j)*28/250*1e-3! Molecular weight of C(15)H(27)N(0.3)O(4.5)
1259 conv4= (dtstep/dz8w(i,k,j))*alt(i,k,j)*28/226*1e-3 ! Molecular weight of C(15)H(27)N(0.3)O(0.9)
1260 oconv3= (dtstep/dz8w(i,k,j))*alt(i,k,j)*28/283*1e-3*4.5 !For biomass there are 4.5 moles of ) /mole of C15H27N0.3
1261 oconv4=(dtstep/dz8w(i,k,j))*alt(i,k,j)*28/226*1e-3*0.9 !For fossil there are 0.9 moles of O per mole of C15H27N0.3
1262 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1263 +emis_ant(i,k,j,p_e_so2)*conv
1264 chem(i,k,j,p_c2h6) = chem(i,k,j,p_c2h6) &
1265 +emis_ant(i,k,j,p_e_c2h6)*conv
1266 chem(i,k,j,p_c3h8) = chem(i,k,j,p_c3h8) &
1267 +emis_ant(i,k,j,p_e_c3h8)*conv
1268 chem(i,k,j,p_c2h2) = chem(i,k,j,p_c2h2) &
1269 +emis_ant(i,k,j,p_e_c2h2)*conv
1270 chem(i,k,j,p_alk3) = chem(i,k,j,p_alk3) &
1271 +emis_ant(i,k,j,p_e_alk3)*conv
1272 chem(i,k,j,p_alk4) = chem(i,k,j,p_alk4) &
1273 +emis_ant(i,k,j,p_e_alk4)*conv
1274 chem(i,k,j,p_alk5) = chem(i,k,j,p_alk5) &
1275 +emis_ant(i,k,j,p_e_alk5)*conv
1276 chem(i,k,j,p_ethene) = chem(i,k,j,p_ethene) &
1277 +emis_ant(i,k,j,p_e_ethene)*conv
1278 chem(i,k,j,p_c3h6) = chem(i,k,j,p_c3h6) &
1279 +emis_ant(i,k,j,p_e_c3h6)*conv
1280 chem(i,k,j,p_ole1) = chem(i,k,j,p_ole1) &
1281 +emis_ant(i,k,j,p_e_ole1)*conv
1282 chem(i,k,j,p_ole2) = chem(i,k,j,p_ole2) &
1283 +emis_ant(i,k,j,p_e_ole2)*conv
1284 chem(i,k,j,p_aro1) = chem(i,k,j,p_aro1) &
1285 +emis_ant(i,k,j,p_e_aro1)*conv
1286 chem(i,k,j,p_aro2) = chem(i,k,j,p_aro2) &
1287 +emis_ant(i,k,j,p_e_aro2)*conv
1288 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
1289 +emis_ant(i,k,j,p_e_hcho)*conv
1290 chem(i,k,j,p_ccho) = chem(i,k,j,p_ccho) &
1291 +emis_ant(i,k,j,p_e_ccho)*conv
1292 chem(i,k,j,p_rcho) = chem(i,k,j,p_rcho) &
1293 +emis_ant(i,k,j,p_e_rcho)*conv
1294 chem(i,k,j,p_acet) = chem(i,k,j,p_acet) &
1295 +emis_ant(i,k,j,p_e_acet)*conv
1296 chem(i,k,j,p_mek) = chem(i,k,j,p_mek) &
1297 +emis_ant(i,k,j,p_e_mek)*conv
1298 chem(i,k,j,p_isoprene) = chem(i,k,j,p_isoprene) &
1299 +emis_ant(i,k,j,p_e_isoprene)*conv
1300 chem(i,k,j,p_terp) = chem(i,k,j,p_terp) &
1301 +emis_ant(i,k,j,p_e_terp)*conv
1302 chem(i,k,j,p_sesq) = chem(i,k,j,p_sesq) &
1303 +emis_ant(i,k,j,p_e_sesq)*conv
1304 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
1305 +emis_ant(i,k,j,p_e_co)*conv
1306 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
1307 +emis_ant(i,k,j,p_e_no)*conv
1308 chem(i,k,j,p_no2) = chem(i,k,j,p_no2) &
1309 +emis_ant(i,k,j,p_e_no2)*conv
1310 chem(i,k,j,p_phen) = chem(i,k,j,p_phen) &
1311 +emis_ant(i,k,j,p_e_phen)*conv
1312 chem(i,k,j,p_cres) = chem(i,k,j,p_cres) &
1313 +emis_ant(i,k,j,p_e_cres)*conv
1314 chem(i,k,j,p_meoh) = chem(i,k,j,p_meoh) &
1315 +emis_ant(i,k,j,p_e_meoh)*conv
1316 chem(i,k,j,p_gly) = chem(i,k,j,p_gly) &
1317 +emis_ant(i,k,j,p_e_gly)*conv
1318 chem(i,k,j,p_mgly) = chem(i,k,j,p_mgly) &
1319 +emis_ant(i,k,j,p_e_mgly)*conv
1320 chem(i,k,j,p_bacl) = chem(i,k,j,p_bacl) &
1321 +emis_ant(i,k,j,p_e_bacl)*conv
1322 chem(i,k,j,p_isoprod) = chem(i,k,j,p_isoprod) &
1323 +emis_ant(i,k,j,p_e_isoprod)*conv
1324 chem(i,k,j,p_methacro) = chem(i,k,j,p_methacro) &
1325 +emis_ant(i,k,j,p_e_methacro)*conv
1326 chem(i,k,j,p_mvk) = chem(i,k,j,p_mvk) &
1327 +emis_ant(i,k,j,p_e_mvk)*conv
1328 chem(i,k,j,p_prod2) = chem(i,k,j,p_prod2) &
1329 +emis_ant(i,k,j,p_e_prod2)*conv
1330 chem(i,k,j,p_ch4) = chem(i,k,j,p_ch4) &
1331 +emis_ant(i,k,j,p_e_ch4)*conv
1332 chem(i,k,j,p_bald) = chem(i,k,j,p_bald) &
1333 +emis_ant(i,k,j,p_e_bald)*conv
1334 chem(i,k,j,p_hcooh) = chem(i,k,j,p_hcooh) &
1335 +emis_ant(i,k,j,p_e_hcooh)*conv
1336 chem(i,k,j,p_cco_oh) = chem(i,k,j,p_cco_oh) &
1337 +emis_ant(i,k,j,p_e_cco_oh)*conv
1338 chem(i,k,j,p_rco_oh) = chem(i,k,j,p_rco_oh) &
1339 +emis_ant(i,k,j,p_e_rco_oh)*conv
1340 chem(i,k,j,p_nh3) = chem(i,k,j,p_nh3) &
1341 +emis_ant(i,k,j,p_e_nh3)*conv
1343 !Use OM/OC of 1.25 for fossil and OM:OC of 1.57 for biomass
1344 ! O:C=0.06,H:C=1.8, N:C=0.02 for fossil : OM/OC=(16*0.06+12+14*0.02+12)/12=1.25
1345 !O:C=0.3 H:C=1.8, N:C=0.02 for biomass, OM/OC=1.57 for biomass
1347 chem(i,k,j,p_pcg1_b_c) = chem(i,k,j,p_pcg1_b_c) &
1348 +(emis_ant(i,k,j,p_e_orgi_bb)/1.57+emis_ant(i,k,j,p_e_orgj_bb)/1.57)*conv3*1.17
1349 chem(i,k,j,p_pcg2_b_c) = chem(i,k,j,p_pcg2_b_c) &
1350 +(emis_ant(i,k,j,p_e_orgi_bb)/1.57+emis_ant(i,k,j,p_e_orgj_bb)/1.57)*conv3*7.605
1351 chem(i,k,j,p_pcg1_f_c) = chem(i,k,j,p_pcg1_f_c) &
1352 +(emis_ant(i,k,j,p_e_orgi_a)/1.25+emis_ant(i,k,j,p_e_orgj_a)/1.25)*conv3*1.17
1353 chem(i,k,j,p_pcg2_f_c) = chem(i,k,j,p_pcg2_f_c) &
1354 +(emis_ant(i,k,j,p_e_orgi_a)/1.25+emis_ant(i,k,j,p_e_orgj_a)/1.25)*conv3*7.605
1355 chem(i,k,j,p_pcg1_b_o) = chem(i,k,j,p_pcg1_b_o) &
1356 +(emis_ant(i,k,j,p_e_orgi_bb)/1.57+emis_ant(i,k,j,p_e_orgj_bb)/1.57)*conv3*0.40
1357 chem(i,k,j,p_pcg2_b_o) = chem(i,k,j,p_pcg2_b_o) &
1358 +(emis_ant(i,k,j,p_e_orgi_bb)/1.57+emis_ant(i,k,j,p_e_orgj_bb)/1.57)*conv3*2.60
1359 chem(i,k,j,p_pcg1_f_o) = chem(i,k,j,p_pcg1_f_o) &
1360 +(emis_ant(i,k,j,p_e_orgi_a)/1.25+emis_ant(i,k,j,p_e_orgj_a)/1.25)*conv3*0.08
1361 chem(i,k,j,p_pcg2_f_o) = chem(i,k,j,p_pcg2_f_o) &
1362 +(emis_ant(i,k,j,p_e_orgi_a)/1.25+emis_ant(i,k,j,p_e_orgj_a)/1.25)*conv3*0.52
1365 end do
1366 end do
1367 end do
1368 else
1369 do j=jts,jte
1370 do i=its,ite
1371 do k=kts,min(config_flags%kemit,kte-ksub)
1372 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1373 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1374 +emis_ant(i,k,j,p_e_so2)*conv
1375 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
1376 +emis_ant(i,k,j,p_e_co)*conv
1377 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
1378 +emis_ant(i,k,j,p_e_no)*conv
1379 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
1380 +emis_ant(i,k,j,p_e_hcho)*conv
1381 end do
1382 end do
1383 end do
1384 endif
1385 !BSINGH - Adding add_biogenics call
1386 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
1387 e_bio,ne_area, &
1388 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
1389 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
1390 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
1391 ebio_sesq,ebio_mbo, &
1392 ids,ide, jds,jde, kds,kde, &
1393 ims,ime, jms,jme, kms,kme, &
1394 its,ite, jts,jte, kts,kte )
1396 CASE (GOCARTRACM_KPP,GOCARTRADM2)
1397 IF(config_flags%emiss_inpt_opt /= 3 ) then
1398 IF(config_flags%kemit .GT. kte-ksub) THEN
1399 k=config_flags%kemit
1400 write(message,'(" WARNING: EMISSIONS_DRIVER: KEMIT > KTE ",3i6)') kme,kte-ksub,k
1401 CALL WRF_MESSAGE (message)
1402 ENDIF
1403 call wrf_debug(15,'emissions_driver calling add_anthropogenics')
1404 call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,alt, &
1405 chem, emis_ant,emis_aircraft, &
1406 ids,ide, jds,jde, kds,kde, &
1407 ims,ime, jms,jme, kms,kme, &
1408 its,ite, jts,jte, kts,kte )
1409 call wrf_debug(15,'emissions_driver calling add_biogenics')
1410 ! Do NOT call add_biogenics if using MEGAN v2.04 biogenic emissions
1411 ! module
1412 call add_biogenics(id,dtstep,dz8w,config_flags,rho_phy,chem, &
1413 e_bio,ne_area, &
1414 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
1415 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
1416 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
1417 ebio_sesq,ebio_mbo, &
1418 ids,ide, jds,jde, kds,kde, &
1419 ims,ime, jms,jme, kms,kme, &
1420 its,ite, jts,jte, kts,kte )
1422 end if ! emiss_inpt_opt /= 3
1424 !
1425 ! simple fix for now for emiss_opt=3
1426 !
1427 do j=jts,jte
1428 do i=its,ite
1429 do k=kts,min(config_flags%kemit,kte-ksub)
1430 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1431 chem(i,k,j,p_bc1) = chem(i,k,j,p_bc1) &
1432 +(emis_ant(i,k,j,p_e_eci)+emis_ant(i,k,j,p_e_ecj))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1433 chem(i,k,j,p_oc1) = chem(i,k,j,p_oc1) &
1434 +(emis_ant(i,k,j,p_e_orgj)+emis_ant(i,k,j,p_e_orgi))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1435 chem(i,k,j,p_p25) = chem(i,k,j,p_p25) &
1436 +(emis_ant(i,k,j,p_e_pm25j)+emis_ant(i,k,j,p_e_pm25i) &
1437 + emis_ant(i,k,j,p_e_no3j)+emis_ant(i,k,j,p_e_no3i)) &
1438 *alt(i,k,j)*dtstep/dz8w(i,k,j)
1439 chem(i,k,j,p_sulf) = chem(i,k,j,p_sulf) &
1440 +(emis_ant(i,k,j,p_e_so4i)+emis_ant(i,k,j,p_e_so4j))*alt(i,k,j)*dtstep/dz8w(i,k,j)*mwdry/mw_so4_aer*1.e-3
1441 end do
1442 end do
1443 end do
1445 CASE (GOCART_SIMPLE)
1446 !
1447 ! simple fix for now
1448 !
1449 !
1450 if(config_flags%emiss_opt <= 5 ) then
1451 do j=jts,jte
1452 do i=its,ite
1453 do k=kts,min(config_flags%kemit,kte-ksub)
1454 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1455 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1456 +emis_ant(i,k,j,p_e_so2)*conv
1457 chem(i,k,j,p_bc1) = chem(i,k,j,p_bc1) &
1458 +(emis_ant(i,k,j,p_e_eci)+emis_ant(i,k,j,p_e_ecj))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1459 chem(i,k,j,p_oc1) = chem(i,k,j,p_oc1) &
1460 +(emis_ant(i,k,j,p_e_orgj)+emis_ant(i,k,j,p_e_orgi))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1461 ! +(emis_ant(i,k,j,p_e_eci)+emis_ant(i,k,j,p_e_ecj))*7.*alt(i,k,j)*dtstep/dz8w(i,k,j)
1462 chem(i,k,j,p_p25) = chem(i,k,j,p_p25) &
1463 +(emis_ant(i,k,j,p_e_pm25j)+emis_ant(i,k,j,p_e_pm25i) &
1464 +emis_ant(i,k,j,p_e_no3j)+emis_ant(i,k,j,p_e_no3i)) &
1465 *alt(i,k,j)*dtstep/dz8w(i,k,j)
1466 chem(i,k,j,p_sulf) = chem(i,k,j,p_sulf) &
1467 +(emis_ant(i,k,j,p_e_so4i)+emis_ant(i,k,j,p_e_so4j)) &
1468 *alt(i,k,j)*dtstep/dz8w(i,k,j)*mwdry/mw_so4_aer*1.e-3
1469 end do
1470 end do
1471 end do
1472 endif
1473 !
1474 ! next for global gocart emissions
1475 !
1476 if(config_flags%emiss_opt == 6 ) then
1477 do j=jts,jte
1478 do i=its,ite
1479 do k=kts,min(config_flags%kemit,kte-ksub)
1480 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
1481 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
1482 +emis_ant(i,k,j,p_e_so2)*conv
1483 chem(i,k,j,p_bc1) = chem(i,k,j,p_bc1) &
1484 +(emis_ant(i,k,j,p_e_bc))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1485 chem(i,k,j,p_oc1) = chem(i,k,j,p_oc1) &
1486 +(emis_ant(i,k,j,p_e_oc))*alt(i,k,j)*dtstep/dz8w(i,k,j)
1487 chem(i,k,j,p_p25) = chem(i,k,j,p_p25) &
1488 +(emis_ant(i,k,j,p_e_pm_25)) &
1489 *alt(i,k,j)*dtstep/dz8w(i,k,j)
1490 chem(i,k,j,p_p10) = chem(i,k,j,p_p10) &
1491 +(emis_ant(i,k,j,p_e_pm_10)) &
1492 *alt(i,k,j)*dtstep/dz8w(i,k,j)
1493 chem(i,k,j,p_sulf) = chem(i,k,j,p_sulf) &
1494 +emis_ant(i,k,j,p_e_sulf)*conv
1495 end do
1496 end do
1497 end do
1498 endif
1499 ! do this here for now, quick and dirty
1501 CASE DEFAULT
1502 call wrf_debug(15,'emissions_driver NOT CALLING gas add_... routines')
1504 END SELECT gas_addemiss_select
1505 !
1506 ! special treatment for these emissions. They come in only at one time
1507 ! (global emissions data set used here), and then a durnal variation is added on in this routine
1508 !
1509 emiss_select: SELECT CASE(config_flags%emiss_inpt_opt)
1510 CASE (EMISS_INPT_CPTEC)
1511 call wrf_debug(15,'emissions_driver calling add_emiss_cptec')
1512 call add_emis_cptec(id,dtstep,ktau,dz8w,config_flags,curr_secs, &
1513 rho_phy,chem, &
1514 julday,gmt,xlat,xlong,t_phy,p_phy, &
1515 emis_ant, &
1516 ids,ide, jds,jde, kds,kde, &
1517 ims,ime, jms,jme, kms,kme, &
1518 its,ite, jts,jte, kts,kte )
1519 CASE DEFAULT
1520 call wrf_debug(15,'emissions_driver not calling add_emiss_cptec')
1521 END SELECT emiss_select
1523 aer_addemiss_select: SELECT CASE(config_flags%chem_opt)
1525 CASE (RADM2SORG,RADM2SORG_AQ,RADM2SORG_AQCHEM,RADM2SORG_KPP, &
1526 RACMSORG_AQ,RACMSORG_AQCHEM_KPP,RACM_ESRLSORG_AQCHEM_KPP,RACMSORG_KPP,RACM_ESRLSORG_KPP,CBMZSORG,CBMZSORG_AQ, &
1527 CB05_SORG_AQ_KPP)
1528 call wrf_debug(15,'emissions_driver calling sorgam_addemiss')
1529 call sorgam_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, chem, &
1530 ebu, &
1531 slai,ust,smois,ivgtyp,isltyp, &
1532 emis_ant,dust_emiss_active, &
1533 seasalt_emiss_active,config_flags%kemit, &
1534 config_flags%biomass_burn_opt, &
1535 config_flags%num_soil_layers,config_flags%emiss_opt, &
1536 config_flags%dust_opt, &
1537 ktau,p8w,u_phy,v_phy,rho_phy,g,dx,erod, &
1538 ids,ide, jds,jde, kds,kde, &
1539 ims,ime, jms,jme, kms,kme, &
1540 its,ite, jts,jte, kts,kte )
1542 CASE (CB05_SORG_VBS_AQ_KPP)
1543 call wrf_debug(15,'emissions_driver calling sorgam_vbs_addemiss')
1544 call sorgam_vbs_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, chem, &
1545 ebu, &
1546 slai,ust,smois,ivgtyp,isltyp, &
1547 emis_ant,dust_emiss_active, &
1548 seasalt_emiss_active,config_flags%kemit, &
1549 config_flags%biomass_burn_opt, &
1550 config_flags%num_soil_layers,config_flags%emiss_opt, &
1551 config_flags%dust_opt, &
1552 ktau,p8w,u_phy,v_phy,rho_phy,g,dx,erod, &
1553 emis_seas2, &
1554 ids,ide, jds,jde, kds,kde, &
1555 ims,ime, jms,jme, kms,kme, &
1556 its,ite, jts,jte, kts,kte )
1558 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1559 CASE (RACM_SOA_VBS_KPP,RACM_SOA_VBS_AQCHEM_KPP,RACM_SOA_VBS_HET_KPP)
1560 call wrf_debug(15,'emissions_driver calling soa_vbs_addemiss')
1561 call soa_vbs_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, chem, &
1562 ebu, &
1563 slai,ust,smois,ivgtyp,isltyp, &
1564 emis_ant,dust_emiss_active, &
1565 seasalt_emiss_active,config_flags%kemit, &
1566 config_flags%biomass_burn_opt, &
1567 config_flags%num_soil_layers,config_flags%emiss_opt, &
1568 config_flags%dust_opt, &
1569 ktau,p8w,u_phy,v_phy,rho_phy,g,dx,erod, &
1570 ids,ide, jds,jde, kds,kde, &
1571 ims,ime, jms,jme, kms,kme, &
1572 its,ite, jts,jte, kts,kte )
1573 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1574 !
1575 !Added the aerosol case SAPRC99_MOSAIC_4BIN_VBS2_KPP to call mosaic addemiss
1576 CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_KPP, CBMZ_MOSAIC_8BIN, &
1577 CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ, &
1578 CBMZ_MOSAIC_DMS_4BIN, CBMZ_MOSAIC_DMS_8BIN, &
1579 CBMZ_MOSAIC_DMS_4BIN_AQ, CBMZ_MOSAIC_DMS_8BIN_AQ,SAPRC99_MOSAIC_4BIN_VBS2_KPP,&
1580 MOZART_MOSAIC_4BIN_KPP, MOZART_MOSAIC_4BIN_AQ_KPP, &
1581 CRI_MOSAIC_8BIN_AQ_KPP, CRI_MOSAIC_4BIN_AQ_KPP,SAPRC99_MOSAIC_8BIN_VBS2_AQ_KPP, &
1582 SAPRC99_MOSAIC_8BIN_VBS2_KPP )
1583 call wrf_debug(15,'emissions_driver calling mosaic_addemiss')
1584 call mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, &
1585 config_flags, chem, slai, ust, smois, ivgtyp, isltyp, &
1586 emis_ant,ebu,config_flags%biomass_burn_opt, &
1587 config_flags%dust_opt, &
1588 ktau,u_phy,v_phy,rho_phy,g,dx,erod, &
1589 dust_emiss_active, seasalt_emiss_active, &
1590 seas_flux,emis_dust, &
1591 ids,ide, jds,jde, kds,kde, &
1592 ims,ime, jms,jme, kms,kme, &
1593 its,ite, jts,jte, kts,kte )
1595 CASE ( CBMZ_CAM_MAM3_NOAQ, CBMZ_CAM_MAM3_AQ, CBMZ_CAM_MAM7_NOAQ, CBMZ_CAM_MAM7_AQ )
1596 call wrf_debug(15,'emissions_driver calling cam_mam_addemiss')
1597 call cam_mam_addemiss( &
1598 id, dtstep, u10, v10, alt, dz8w, xland, &
1599 config_flags, chem, slai, ust, smois, ivgtyp, isltyp, &
1600 emis_ant,ebio_iso,ebio_olt,ebio_oli,rho_phy, &
1601 dust_emiss_active, seasalt_emiss_active, &
1602 ids,ide, jds,jde, kds,kde, &
1603 ims,ime, jms,jme, kms,kme, &
1604 its,ite, jts,jte, kts,kte )
1605 call wrf_debug(15,'emissions_driver backfrm cam_mam_addemiss')
1607 CASE DEFAULT
1608 call wrf_debug(15,'emissions_driver NOT CALLING aer add_... routines')
1610 END SELECT aer_addemiss_select
1612 ! Lightning NO emission
1613 CALL lightning_nox_driver ( &
1614 ! Frequently used prognostics
1615 curr_secs=curr_secs, dt=dtstep, dx=dx, dy=dx, &
1616 xlat=xlat, xlon=xlong, xland=xland, ht=ht, &
1617 t_phy=t_phy, p_phy=p_phy, rho=rho_phy, u=u_phy, v=v_phy, w=vvel, &
1618 z=z, moist=moist, &
1619 ic_flashrate=ic_flashrate, cg_flashrate=cg_flashrate, &
1620 ! Scheme specific prognostics
1621 refl=refl_10cm, &
1622 ! Mandatory namelist inputs
1623 lightning_option=config_flags%lightning_option, &
1624 lightning_dt=config_flags%lightning_dt, &
1625 lightning_start_seconds=config_flags%lightning_start_seconds, &
1626 N_IC=config_flags%N_IC, N_CG=config_flags%N_CG, &
1627 lnox_opt=config_flags%lnox_opt, lnox_passive=config_flags%lnox_passive, &
1628 ! Scheme specific namelist inputs
1629 ltng_temp_upper=config_flags%ltng_temp_upper, &
1630 ltng_temp_lower=config_flags%ltng_temp_lower, &
1631 cellcount_method=config_flags%cellcount_method, &
1632 ! Order dependent args for domain, mem, and tile dims
1633 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
1634 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
1635 its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, &
1636 ! outputs
1637 c_no=chem(:,:,:,p_no), & ! NO concentration
1638 lnox_total=tracer(:,:,:,p_lnox_total), &
1639 lnox_ic=tracer(:,:,:,p_lnox_ic), &
1640 lnox_cg=tracer(:,:,:,p_lnox_cg) &
1641 )
1643 END subroutine emissions_driver
1645 END module module_emissions_driver