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