emissions_driver.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:CHEMICS
2 !
3 MODULE module_emissions_driver
4 IMPLICIT NONE
5 CONTAINS
6
7 subroutine emissions_driver(id,ktau,dtstep,DX,stepfirepl, &
8 config_flags, stepbioe,gmt,julday,alt,t_phy,moist,p8w,t8w,u_phy, &
9 v_phy,vvel,e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
10 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
11 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3, &
12 e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2,e_ch3oh, &
13 e_c2h5oh,e_so4i,e_so4j,e_so4c,e_no3i,e_no3j,e_no3c,e_orgc,e_ecc, &
14 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
15 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
16 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
17 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2,mean_fct_agtf,mean_fct_agef, &
18 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
19 firesize_agsv,firesize_aggr, &
20 u10,v10,ivgtyp,isltyp,gsw,vegfra,rmol,ust,znt, &
21 xland,xlat,xlong,z_at_w,z,smois, &
22 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
23 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
24 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
25 noag_grow,noag_nongrow,nononag,slai, &
26 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
27 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
28 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
29 !shc stuff for MEGAN v2.04
30 T2,swdown, &
31 nmegan,EFmegan, &
32 msebio_isop, &
33 mlai, &
34 pftp_bt, pftp_nt, pftp_sb, pftp_hb, &
35 mtsa, &
36 mswdown, &
37 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
38 mebio_acet, mebio_mbo, mebio_no, &
39 current_month, &
40 !shc end stuff for MEGAN v2.04
41 ids,ide, jds,jde, kds,kde, &
42 ims,ime, jms,jme, kms,kme, &
43 its,ite, jts,jte, kts,kte )
44 !----------------------------------------------------------------------
45 USE module_configure
46 USE module_state_description
47 USE module_data_radm2
48 USE module_emissions_anthropogenics
49 USE module_bioemi_simple
50 USE module_bioemi_beis311
51 USE module_bioemi_megan2
52 USE module_cbmz_addemiss
53 USE module_mosaic_addemiss
54 USE module_add_emis_cptec
55 USE module_add_emiss_burn
56 USE module_plumerise1
57 IMPLICIT NONE
58
59 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
60
61 INTEGER, INTENT(IN ) :: id,julday, ne_area, &
62 ids,ide, jds,jde, kds,kde, &
63 ims,ime, jms,jme, kms,kme, &
64 its,ite, jts,jte, kts,kte
65 INTEGER, INTENT(IN ) :: &
66 ktau,stepbioe,stepfirepl
67 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
68 INTENT(IN ) :: moist
69 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
70 INTENT(INOUT ) :: chem
71 REAL, DIMENSION( ims:ime, jms:jme, ne_area ), &
72 INTENT(INOUT ) :: e_bio
73 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
74 INTENT(IN ) :: &
75 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2, &
76 e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25, &
77 e_pm10,e_nh3,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2, &
78 e_ch3oh,e_c2h5oh,e_so4i,e_so4j,e_so4c,e_no3i,e_no3j,e_no3c, &
79 e_orgc,e_ecc
80 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
81 INTENT(INOUT ) :: &
82 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
83 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
84 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
85 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2
86
87 REAL, DIMENSION( ims:ime, jms:jme ), &
88 INTENT(IN ) :: &
89 mean_fct_agtf,mean_fct_agef, &
90 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
91 firesize_agsv,firesize_aggr
92
93 !
94 !
95 !
96 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
97 INTENT(IN ) :: &
98 alt, &
99 t_phy, &
100 p_phy, &
101 dz8w, &
102 t8w,p8w,z_at_w , z , &
103 u_phy,v_phy,vvel,rho_phy
104 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
105 INTENT(IN ) :: &
106 ivgtyp, &
107 isltyp
108 REAL, DIMENSION( ims:ime , jms:jme ) , &
109 INTENT(IN ) :: &
110 u10, &
111 v10, &
112 gsw, &
113 vegfra, &
114 rmol, &
115 ust, &
116 xland, &
117 xlat, &
118 xlong, &
119 znt
120 REAL, DIMENSION( ims:ime, config_flags%num_soil_layers, jms:jme ) , &
121 INTENT(INOUT) :: smois
122
123 REAL, DIMENSION( ims:ime , jms:jme ) , &
124 INTENT(INOUT ) :: &
125 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
126 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
127 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
128 noag_grow,noag_nongrow,nononag,slai, &
129 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
130 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
131 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no
132
133 !shc stuff for MEGAN v2.04
134
135 integer, intent(in ) :: nmegan
136 real, dimension (ims:ime, jms:jme , nmegan) , &
137 intent(inout) :: &
138 EFmegan
139
140
141 real, dimension (ims:ime, jms:jme ) , &
142 intent(in) :: &
143 msebio_isop, &
144 pftp_bt, pftp_nt, pftp_sb, pftp_hb
145
146 real, dimension (ims:ime, jms:jme, 12 ) , &
147 intent(in) :: &
148 mlai, mtsa, mswdown
149
150 real, dimension (ims:ime, jms:jme ) , &
151 intent(inout) :: &
152 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
153 mebio_acet, mebio_mbo, mebio_no
154
155 real, dimension (ims:ime, jms:jme ) , &
156 intent(in) :: &
157 T2, swdown
158
159 integer, intent(in) :: current_month
160
161 !shc end stuff for MEGAN v2.04
162
163 REAL, INTENT(IN ) :: &
164 dtstep, dx, gmt
165 !
166 ! Local variables...
167 !
168 INTEGER :: i, j, k, ksub, dust_emiss_active, seasalt_emiss_active
169 REAL :: conv
170 CHARACTER (LEN=80) :: message
171
172 ! ..
173 ! ..
174 ! .. Intrinsic Functions ..
175 INTRINSIC max, min
176 ! ..
177
178 ! Flags for turning on or off sea salt and/or dust emissions...
179 ! >0 = sea salt/dust emissions turned on
180 ! As of Nov. 2007 this only works for MOSAIC, but is intended to be used
181 ! by other mechanisms when they are linked to these emissions sources.
182 !
183 dust_emiss_active = 0
184 seasalt_emiss_active = 1
185
186 !!$ ksub=1
187 !!$#if ( NMM_CORE == 1 )
188 ksub=0
189 !!$#endif
190 fire_select: SELECT CASE(config_flags%biomass_burn_opt)
191 CASE (BIOMASSB)
192 if(ktau.eq.1.or.mod(ktau,stepfirepl).eq.0)then
193 CALL wrf_debug(15,'fire emissions: calling biomassb')
194 write(0,*)ktau,stepfirepl
195 call plumerise_driver (id,ktau,dtstep, &
196 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
197 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
198 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
199 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2,mean_fct_agtf,mean_fct_agef, &
200 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
201 firesize_agsv,firesize_aggr, &
202 config_flags, t_phy,moist, &
203 chem,rho_phy,vvel,u_phy,v_phy,p_phy, &
204 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,&
205 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3,&
206 e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2,e_ch3oh, &
207 e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc, &
208 z_at_w,z, &
209 ids,ide, jds,jde, kds,kde, &
210 ims,ime, jms,jme, kms,kme, &
211 its,ite, jts,jte, kts,kte )
212
213 endif
214 CALL wrf_debug(15,'fire emissions: adding biomassb emissions')
215 call add_emis_burn(id,dtstep,ktau,dz8w,config_flags,rho_phy,chem,&
216 julday,gmt,xlat,xlong,t_phy,p_phy, &
217 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
218 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
219 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
220 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2, &
221 ids,ide, jds,jde, kds,kde, &
222 ims,ime, jms,jme, kms,kme, &
223 its,ite, jts,jte, kts,kte )
224 CASE DEFAULT
225 CALL wrf_debug(15,'no biomass burning')
226 END SELECT fire_select
227 bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
228 CASE (GUNTHER1)
229 CALL wrf_debug(15,'biogenic emissions: calling Gunther1')
230 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
231 call bio_emissions(id,ktau,dtstep,DX,config_flags, &
232 gmt,julday,t_phy,moist,p8w,t8w, &
233 e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
234 ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w, &
235 ids,ide, jds,jde, kds,kde, &
236 ims,ime, jms,jme, kms,kme, &
237 its,ite, jts,jte, kts,kte )
238 endif
239 CASE (BEIS311)
240 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
241 if(config_flags%chem_opt > RACMSORG .AND. config_flags%chem_opt < 100 ) then !<100: kpp mechs, e.g. RACMSORG_KPP
242 CALL wrf_error_fatal( &
243 "emissions_driver: beis3.1.1 biogenic emis. not currently implemented for CBMZ")
244 endif
245 CALL wrf_debug(15,'biogenic emissions: calling beis3.1.1')
246 call bio_emissions_beis311(id,config_flags,ktau,dtstep, &
247 julday,gmt,xlat,xlong,t_phy,p_phy,gsw, &
248 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
249 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
250 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
251 noag_grow,noag_nongrow,nononag,slai, &
252 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
253 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
254 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
255 ids,ide, jds,jde, kds,kde, &
256 ims,ime, jms,jme, kms,kme, &
257 its,ite, jts,jte, kts,kte )
258 endif
259
260 CASE (MEGAN2) !shc
261 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
262 CALL wrf_debug(15,'biogenic emissions: calling megan v2.04')
263 call bio_emissions_megan2(id,config_flags,ktau,dtstep, &
264 julday,gmt,xlat,xlong,p_phy,rho_phy,dz8w, &
265 chem,ne_area, &
266 current_month, &
267 T2,swdown, &
268 nmegan, EFmegan, msebio_isop, &
269 mlai, &
270 pftp_bt, pftp_nt, pftp_sb, pftp_hb, &
271 mtsa, &
272 mswdown, &
273 mebio_isop, mebio_apin, mebio_bpin, mebio_bcar, &
274 mebio_acet, mebio_mbo, mebio_no, &
275 ebio_iso,ebio_oli,ebio_api,ebio_lim, &
276 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
277 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_no, &
278 e_bio, &
279 ids,ide, jds,jde, kds,kde, &
280 ims,ime, jms,jme, kms,kme, &
281 its,ite, jts,jte, kts,kte )
282 endif
283
284 CASE DEFAULT
285 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0) &
286 e_bio(its:ite,jts:jte,1:ne_area) = 0.
287 !wig: May need to zero out all ebio_xxx arrays too if they are incorporated
288 ! into CBMZ/MOSAIC.
289
290 END SELECT bioem_select
291
292 gas_addemiss_select: SELECT CASE(config_flags%chem_opt)
293 CASE (RADM2, RADM2_KPP, RADM2SORG, RACM, RACMSORG,RACM_KPP,RACMPM_KPP,RACMSORG_KPP, RACM_MIM_KPP,RADM2SORG_KPP)
294 IF(config_flags%emiss_inpt_opt /= 3 ) then
295 IF(config_flags%kemit .GT. kte-ksub) THEN
296 k=config_flags%kemit
297 write(message,'(" WARNING: EMISSIONS_DRIVER: KEMIT > KTE ",3i6)') kme,kte-ksub,k
298 CALL WRF_MESSAGE (message)
299 ENDIF
300 call wrf_debug(15,'emissions_driver calling add_anthropogenics')
301 call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem,&
302 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl, &
303 e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2, &
304 e_pm25,e_pm10,e_nh3, &
305 ids,ide, jds,jde, kds,kde, &
306 ims,ime, jms,jme, kms,kme, &
307 its,ite, jts,jte, kts,kte )
308 call wrf_debug(15,'emissions_driver calling add_biogenics')
309 ! Do NOT call add_biogenics if using MEGAN v2.04 biogenic emissions
310 ! module
311 if ( config_flags%bio_emiss_opt .ne. megan2 ) then !shc
312 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
313 e_bio,ne_area, &
314 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
315 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
316 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
317 ids,ide, jds,jde, kds,kde, &
318 ims,ime, jms,jme, kms,kme, &
319 its,ite, jts,jte, kts,kte )
320 end if !shc
321
322 end if ! emiss_inpt_opt /= 3
323
324 CASE (CBMZ, CBMZ_BB, CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
325 IF(config_flags%kemit .GT. kte-ksub) THEN
326 message = ' EMISSIONS_DRIVER: KEMIT > KME '
327 CALL WRF_ERROR_FATAL (message)
328 ENDIF
329 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_anthro')
330 call cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags, &
331 rho_phy, chem, &
332 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
333 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
334 e_no2,e_ch3oh,e_c2h5oh, &
335 ids,ide, jds,jde, kds,kde, &
336 ims,ime, jms,jme, kms,kme, &
337 its,ite, jts,jte, kts,kte )
338 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_bio')
339 ! Do NOT call add_biogenics if using MEGAN v2.04 biogenic emissions
340 ! module
341 if ( config_flags%bio_emiss_opt .ne. megan2 ) then !shc
342 call cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
343 rho_phy, chem, e_bio, ne_area, e_iso, &
344 ids,ide, jds,jde, kds,kde, &
345 ims,ime, jms,jme, kms,kme, &
346 its,ite, jts,jte, kts,kte )
347 endif
348
349 CASE (CHEM_TRACER)
350 do j=jts,jte
351 do i=its,ite
352 do k=kts,min(config_flags%kemit,kte-ksub)
353 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
354 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
355 +e_so2(i,k,j)*conv
356 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
357 +e_co(i,k,j)*conv
358 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
359 +e_co(i,k,j)*conv
360 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
361 +e_co(i,k,j)*conv
362 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
363 +e_co(i,k,j)*conv
364 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
365 +e_co(i,k,j)*conv
366 end do
367 end do
368 end do
369
370 CASE DEFAULT
371 call wrf_debug(15,'emissions_driver NOT CALLING gas add_... routines')
372
373 END SELECT gas_addemiss_select
374 !
375 ! special treatment for these emissions. They come in only at one time
376 ! (global emissions data set used here), and then a durnal variation is added on in this routine
377 !
378 emiss_select: SELECT CASE(config_flags%emiss_inpt_opt)
379 CASE (EMISS_INPT_CPTEC)
380 call wrf_debug(15,'emissions_driver calling add_emiss_cptec')
381 call add_emis_cptec(id,dtstep,ktau,dz8w,config_flags,rho_phy,chem,&
382 julday,gmt,xlat,xlong,t_phy,p_phy, &
383 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl, &
384 e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2, &
385 e_pm25,e_pm10,e_nh3, &
386 ! ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
387 ! ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
388 ! ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
389 ! ebu_ket,ebu_macr,ebu_ora1,ebu_ora2, &
390 ids,ide, jds,jde, kds,kde, &
391 ims,ime, jms,jme, kms,kme, &
392 its,ite, jts,jte, kts,kte )
393 CASE DEFAULT
394 call wrf_debug(15,'emissions_driver not calling add_emiss_cptec')
395 END SELECT emiss_select
396
397 aer_addemiss_select: SELECT CASE(config_flags%chem_opt)
398
399 CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
400 call wrf_debug(15,'emissions_driver calling mosaic_addemiss')
401 call mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, &
402 config_flags, chem, slai, ust, smois, ivgtyp, isltyp, &
403 e_pm10,e_pm25,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj, &
404 e_so4i,e_so4j,e_so4c,e_no3i,e_no3j,e_no3c,e_orgc,e_ecc, &
405 dust_emiss_active, seasalt_emiss_active, &
406 ids,ide, jds,jde, kds,kde, &
407 ims,ime, jms,jme, kms,kme, &
408 its,ite, jts,jte, kts,kte )
409
410 CASE DEFAULT
411 call wrf_debug(15,'emissions_driver NOT CALLING aer add_... routines')
412
413 END SELECT aer_addemiss_select
414
415 END subroutine emissions_driver
416
417 END module module_emissions_driver