module_cbmz_addemiss.F
References to this file elsewhere.
1 !**********************************************************************************
2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
6 !
7 ! CBMZ module: see module_cbmz.F for information and terms of use
8 !**********************************************************************************
9
10 MODULE module_cbmz_addemiss
11 !WRF:MODEL_LAYER:CHEMICS
12
13
14
15 integer, parameter :: cbmz_addemiss_masscheck = -1
16 ! only do emissions masscheck calcs when this is positive
17
18
19
20 CONTAINS
21
22
23
24 !----------------------------------------------------------------------
25 subroutine cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags, &
26 rho_phy, chem, &
27 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
28 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
29 e_no2,e_ch3oh,e_c2h5oh, &
30 ids,ide, jds,jde, kds,kde, &
31 ims,ime, jms,jme, kms,kme, &
32 its,ite, jts,jte, kts,kte )
33 !
34 ! adds emissions for cbmz trace gas species
35 ! (i.e., emissions tendencies over time dtstep are applied
36 ! to the trace gas concentrations)
37 !
38
39 USE module_configure
40 USE module_state_description
41 USE module_data_radm2
42
43 IMPLICIT NONE
44
45 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
46
47 INTEGER, INTENT(IN ) :: id, &
48 ids,ide, jds,jde, kds,kde, &
49 ims,ime, jms,jme, kms,kme, &
50 its,ite, jts,jte, kts,kte
51
52 REAL, INTENT(IN ) :: dtstep
53
54 ! trace species mixing ratios (gases=ppm)
55 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
56 INTENT(INOUT ) :: chem
57 !
58 ! emissions arrays (v.1: ppm m/min; v.2: mole km^-2 hr^-1)
59 !
60 ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
61 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
62 INTENT(IN ) :: &
63 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
64 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
65 e_no2,e_ch3oh,e_c2h5oh
66
67 ! layer thickness (m)
68 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
69 INTENT(IN ) :: dz8w, rho_phy
70
71 ! local variables
72 integer :: i,j,k
73 real, parameter :: efact1 = 1.0/60.0
74 real :: conv
75 double precision :: chem_sum(num_chem)
76
77
78 ! do mass check initial calc
79 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
80 id, config_flags, 1, 'cbmz_addemiss', &
81 dtstep, efact1, dz8w, chem, chem_sum, &
82 ids,ide, jds,jde, kds,kde, &
83 ims,ime, jms,jme, kms,kme, &
84 its,ite, jts,jte, kts,kte, &
85 21, &
86 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
87 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
88 e_no2,e_ch3oh,e_c2h5oh )
89
90
91 !
92 ! add emissions
93 !
94 do 100 j=jts,jte
95 do 100 i=its,ite
96
97 DO k=kts,min(config_flags%kemit,kte)
98 !v1 units: conv = dtstep/(dz8w(i,k,j)*60.)
99 !v2 units:
100 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
101
102 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
103 if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. &
104 (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. &
105 (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K) ) then
106 print*
107 print*,"Converted emissions for CBMZ:"
108 print*,"e_csl=",e_csl(i,k,j)*conv
109 print*,"e_so2=",e_so2(i,k,j)*conv
110 print*,"e_no=",e_no(i,k,j)*conv
111 print*,"e_ald=",e_ald(i,k,j)*conv
112 print*,"e_hcho=",e_hcho(i,k,j)*conv
113 print*,"e_ora2=",e_ora2(i,k,j)*conv
114 print*,"e_nh3=",e_nh3(i,k,j)*conv
115 print*,"e_hc3=",e_hc3(i,k,j)*conv
116 print*,"e_hc5=",e_hc5(i,k,j)*conv
117 print*,"e_hc8=",e_hc8(i,k,j)*conv
118 print*,"e_eth=",e_eth(i,k,j)*conv
119 print*,"e_co=",e_co(i,k,j)*conv
120 print*,"e_ol2=",e_ol2(i,k,j)*conv
121 print*,"e_olt=",e_olt(i,k,j)*conv
122 print*,"e_oli=",e_oli(i,k,j)*conv
123 print*,"e_tol=",e_tol(i,k,j)*conv
124 print*,"e_xyl=",e_xyl(i,k,j)*conv
125 print*,"e_ket=",e_ket(i,k,j)*conv
126 end if
127 #endif
128
129 chem(i,k,j,p_csl) = chem(i,k,j,p_csl) &
130 +e_csl(i,k,j)*conv
131 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
132 +e_so2(i,k,j)*conv
133 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
134 +e_no(i,k,j)*conv
135 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
136 +e_ald(i,k,j)*conv
137 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
138 +e_hcho(i,k,j)*conv
139 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
140 +e_ora2(i,k,j)*conv
141 chem(i,k,j,p_nh3) = chem(i,k,j,p_nh3) &
142 +e_nh3(i,k,j)*conv
143 chem(i,k,j,p_eth) = chem(i,k,j,p_eth) &
144 +e_eth(i,k,j)*conv
145 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
146 +e_co(i,k,j)*conv
147 chem(i,k,j,p_ol2) = chem(i,k,j,p_ol2) &
148 +e_ol2(i,k,j)*conv
149 chem(i,k,j,p_olt) = chem(i,k,j,p_olt) &
150 +e_olt(i,k,j)*conv
151 chem(i,k,j,p_oli) = chem(i,k,j,p_oli) &
152 +e_oli(i,k,j)*conv
153 chem(i,k,j,p_tol) = chem(i,k,j,p_tol) &
154 +e_tol(i,k,j)*conv
155 chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) &
156 +e_xyl(i,k,j)*conv
157 chem(i,k,j,p_ket) = chem(i,k,j,p_ket) &
158 +e_ket(i,k,j)*conv
159
160 ! when emissions input file is "radm2sorg" variety, calc par emissions as a
161 ! combination of the anthropogenic emissions for radm2 primary voc species
162 if ( (config_flags%emiss_inpt_opt == EMISS_INPT_DEFAULT) .or. &
163 (config_flags%emiss_inpt_opt == EMISS_INPT_PNNL_RS) ) then
164 chem(i,k,j,p_par) = chem(i,k,j,p_par) &
165 + conv* &
166 ( 0.4*e_ald(i,k,j) + 2.9*e_hc3(i,k,j) &
167 + 4.8*e_hc5(i,k,j) + 7.9*e_hc8(i,k,j) &
168 + 0.9*e_ket(i,k,j) + 2.8*e_oli(i,k,j) &
169 + 1.8*e_olt(i,k,j) + 1.0*e_ora2(i,k,j) )
170
171 ! when emissions input file is "cbmzmosaic" variety,
172 ! the par emissions are read into e_hc5
173 ! and there are emissions for other species
174 else
175 chem(i,k,j,p_par) = chem(i,k,j,p_par) &
176 + conv*e_hc5(i,k,j)
177
178 chem(i,k,j,p_no2) = chem(i,k,j,p_no2) &
179 + conv*e_no2(i,k,j)
180 chem(i,k,j,p_ch3oh) = chem(i,k,j,p_ch3oh) &
181 + conv*e_ch3oh(i,k,j)
182 chem(i,k,j,p_c2h5oh) = chem(i,k,j,p_c2h5oh) &
183 + conv*e_c2h5oh(i,k,j)
184 end if
185
186 END DO
187 100 continue
188
189
190 ! do mass check final calc
191 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
192 id, config_flags, 2, 'cbmz_addemiss', &
193 dtstep, efact1, dz8w, chem, chem_sum, &
194 ids,ide, jds,jde, kds,kde, &
195 ims,ime, jms,jme, kms,kme, &
196 its,ite, jts,jte, kts,kte, &
197 21, &
198 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
199 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
200 e_no2,e_ch3oh,e_c2h5oh )
201
202
203 END subroutine cbmz_addemiss_anthro
204
205
206
207 !----------------------------------------------------------------------
208 subroutine cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
209 rho_phy, chem, e_bio, ne_area, e_iso, &
210 ids,ide, jds,jde, kds,kde, &
211 ims,ime, jms,jme, kms,kme, &
212 its,ite, jts,jte, kts,kte )
213
214 USE module_configure
215 USE module_state_description
216 USE module_data_radm2
217 USE module_aerosols_sorgam
218
219 IMPLICIT NONE
220
221 ! subr arguments
222 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
223
224 INTEGER, INTENT(IN ) :: id, ne_area, &
225 ids,ide, jds,jde, kds,kde, &
226 ims,ime, jms,jme, kms,kme, &
227 its,ite, jts,jte, kts,kte
228
229 REAL, INTENT(IN ) :: dtstep
230
231 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
232 INTENT(INOUT ) :: chem
233
234 REAL, DIMENSION( ims:ime, jms:jme,ne_area ), &
235 INTENT(IN ) :: e_bio
236
237 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
238 INTENT(IN ) :: e_iso
239
240 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
241 INTENT(IN ) :: dz8w, rho_phy
242
243
244 ! local variables
245 integer i,j,k,n
246 real, parameter :: efact1 = 1.0/60.0
247 double precision :: chem_sum(num_chem)
248
249
250 !
251 ! apply gunther online biogenic gas emissions when bio_emiss_opt == GUNTHER1
252 !
253 if (config_flags%bio_emiss_opt == GUNTHER1) then
254
255 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
256 id, config_flags, 1, 'cbmz_addemiss_bioaa', &
257 dtstep, efact1, dz8w, chem, chem_sum, &
258 ids,ide, jds,jde, kds,kde, &
259 ims,ime, jms,jme, kms,kme, &
260 its,ite, jts,jte, kts,kte, &
261 kms, 13, &
262 e_bio(ims,jms,lald), e_bio(ims,jms,lhc3), &
263 e_bio(ims,jms,lhc5), e_bio(ims,jms,lhc8), &
264 e_bio(ims,jms,lhcho), e_bio(ims,jms,liso), &
265 e_bio(ims,jms,lket), e_bio(ims,jms,lno), &
266 e_bio(ims,jms,loli), e_bio(ims,jms,lolt), &
267 e_bio(ims,jms,lora1), e_bio(ims,jms,lora2), &
268 e_bio(ims,jms,lxyl), &
269 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
270 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
271 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
272 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl) )
273
274 do j=jts,jte
275 do i=its,ite
276 chem(i,kts,j,p_so2) = chem(i,kts,j,p_so2) &
277 + e_bio(i,j,lso2)/(dz8w(i,kts,j)*60.)*dtstep
278 chem(i,kts,j,p_sulf) = chem(i,kts,j,p_sulf) &
279 + e_bio(i,j,lsulf)/(dz8w(i,kts,j)*60.)*dtstep
280 chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2) &
281 + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
282 chem(i,kts,j,p_no) = chem(i,kts,j,p_no) &
283 + e_bio(i,j,lno)/(dz8w(i,kts,j)*60.)*dtstep
284 chem(i,kts,j,p_o3) = chem(i,kts,j,p_o3) &
285 + e_bio(i,j,lo3)/(dz8w(i,kts,j)*60.)*dtstep
286 chem(i,kts,j,p_hno3) = chem(i,kts,j,p_hno3) &
287 + e_bio(i,j,lhno3)/(dz8w(i,kts,j)*60.)*dtstep
288 chem(i,kts,j,p_h2o2) = chem(i,kts,j,p_h2o2) &
289 + e_bio(i,j,lh2o2)/(dz8w(i,kts,j)*60.)*dtstep
290 chem(i,kts,j,p_ald) = chem(i,kts,j,p_ald) &
291 + e_bio(i,j,lald)/(dz8w(i,kts,j)*60.)*dtstep
292 chem(i,kts,j,p_hcho) = chem(i,kts,j,p_hcho) &
293 + e_bio(i,j,lhcho)/(dz8w(i,kts,j)*60.)*dtstep
294 chem(i,kts,j,p_op1) = chem(i,kts,j,p_op1) &
295 + e_bio(i,j,lop1)/(dz8w(i,kts,j)*60.)*dtstep
296 chem(i,kts,j,p_op2) = chem(i,kts,j,p_op2) &
297 + e_bio(i,j,lop2)/(dz8w(i,kts,j)*60.)*dtstep
298 chem(i,kts,j,p_ora1) = chem(i,kts,j,p_ora1) &
299 + e_bio(i,j,lora1)/(dz8w(i,kts,j)*60.)*dtstep
300 chem(i,kts,j,p_ora2) = chem(i,kts,j,p_ora2) &
301 + e_bio(i,j,lora2)/(dz8w(i,kts,j)*60.)*dtstep
302 chem(i,kts,j,p_nh3) = chem(i,kts,j,p_nh3) &
303 + e_bio(i,j,lnh3)/(dz8w(i,kts,j)*60.)*dtstep
304 chem(i,kts,j,p_n2o5) = chem(i,kts,j,p_n2o5) &
305 + e_bio(i,j,ln2o5)/(dz8w(i,kts,j)*60.)*dtstep
306 chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2) &
307 + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
308 chem(i,kts,j,p_pan) = chem(i,kts,j,p_pan) &
309 + e_bio(i,j,lpan)/(dz8w(i,kts,j)*60.)*dtstep
310 chem(i,kts,j,p_eth) = chem(i,kts,j,p_eth) &
311 + e_bio(i,j,leth)/(dz8w(i,kts,j)*60.)*dtstep
312 chem(i,kts,j,p_co) = chem(i,kts,j,p_co) &
313 + e_bio(i,j,lco)/(dz8w(i,kts,j)*60.)*dtstep
314 chem(i,kts,j,p_ol2) = chem(i,kts,j,p_ol2) &
315 + e_bio(i,j,lol2)/(dz8w(i,kts,j)*60.)*dtstep
316 chem(i,kts,j,p_olt) = chem(i,kts,j,p_olt) &
317 + e_bio(i,j,lolt)/(dz8w(i,kts,j)*60.)*dtstep
318 chem(i,kts,j,p_oli) = chem(i,kts,j,p_oli) &
319 + e_bio(i,j,loli)/(dz8w(i,kts,j)*60.)*dtstep
320 chem(i,kts,j,p_tol) = chem(i,kts,j,p_tol) &
321 + e_bio(i,j,ltol)/(dz8w(i,kts,j)*60.)*dtstep
322 chem(i,kts,j,p_xyl) = chem(i,kts,j,p_xyl) &
323 + e_bio(i,j,lxyl)/(dz8w(i,kts,j)*60.)*dtstep
324 chem(i,kts,j,p_hono) = chem(i,kts,j,p_hono) &
325 + e_bio(i,j,lhono)/(dz8w(i,kts,j)*60.)*dtstep
326 chem(i,kts,j,p_hno4) = chem(i,kts,j,p_hno4) &
327 + e_bio(i,j,lhno4)/(dz8w(i,kts,j)*60.)*dtstep
328 chem(i,kts,j,p_ket) = chem(i,kts,j,p_ket) &
329 + e_bio(i,j,lket)/(dz8w(i,kts,j)*60.)*dtstep
330 chem(i,kts,j,p_mgly) = chem(i,kts,j,p_mgly) &
331 + e_bio(i,j,lmgly)/(dz8w(i,kts,j)*60.)*dtstep
332 chem(i,kts,j,p_onit) = chem(i,kts,j,p_onit) &
333 + e_bio(i,j,lonit)/(dz8w(i,kts,j)*60.)*dtstep
334 chem(i,kts,j,p_csl) = chem(i,kts,j,p_csl) &
335 + e_bio(i,j,lcsl)/(dz8w(i,kts,j)*60.)*dtstep
336 chem(i,kts,j,p_iso) = chem(i,kts,j,p_iso) &
337 + e_bio(i,j,liso)/(dz8w(i,kts,j)*60.)*dtstep
338 end do
339 end do
340
341 ! calc par emissions as a combination of the biogenic emissions
342 ! for radm2 primary voc species
343 do j = jts, jte
344 do i = its, ite
345 chem(i,kts,j,p_par) = chem(i,kts,j,p_par) &
346 + (dtstep/(dz8w(i,kts,j)*60.))* &
347 ( 0.4*e_bio(i,j,lald) + 2.9*e_bio(i,j,lhc3) &
348 + 4.8*e_bio(i,j,lhc5) + 7.9*e_bio(i,j,lhc8) &
349 + 0.9*e_bio(i,j,lket) + 2.8*e_bio(i,j,loli) &
350 + 1.8*e_bio(i,j,lolt) + 1.0*e_bio(i,j,lora2) )
351 end do
352 end do
353
354 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
355 id, config_flags, 2, 'cbmz_addemiss_bioaa', &
356 dtstep, efact1, dz8w, chem, chem_sum, &
357 ids,ide, jds,jde, kds,kde, &
358 ims,ime, jms,jme, kms,kme, &
359 its,ite, jts,jte, kts,kte, &
360 kms, 13, &
361 e_bio(ims,jms,lald), e_bio(ims,jms,lhc3), &
362 e_bio(ims,jms,lhc5), e_bio(ims,jms,lhc8), &
363 e_bio(ims,jms,lhcho), e_bio(ims,jms,liso), &
364 e_bio(ims,jms,lket), e_bio(ims,jms,lno), &
365 e_bio(ims,jms,loli), e_bio(ims,jms,lolt), &
366 e_bio(ims,jms,lora1), e_bio(ims,jms,lora2), &
367 e_bio(ims,jms,lxyl), &
368 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
369 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
370 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl), &
371 e_bio(ims,jms,lxyl), e_bio(ims,jms,lxyl) )
372
373 end if
374
375
376 !
377 ! apply offline isoprene emissions when bio_emiss_opt /= GUNTHER1
378 !
379 if (config_flags%bio_emiss_opt /= GUNTHER1) then
380
381 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
382 id, config_flags, 1, 'cbmz_addemiss_biobb', &
383 dtstep, efact1, dz8w, chem, chem_sum, &
384 ids,ide, jds,jde, kds,kde, &
385 ims,ime, jms,jme, kms,kme, &
386 its,ite, jts,jte, kts,kte, &
387 1, &
388 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
389 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
390 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso )
391
392 do j = jts, jte
393 do k = kts, min(config_flags%kemit,kte)
394 do i = its, ite
395 chem(i,k,j,p_iso) = chem(i,k,j,p_iso) + e_iso(i,k,j) &
396 *4.828e-4/rho_phy(i,k,j)*(dtstep/(dz8w(i,k,j)*60.))
397 end do
398 end do
399 end do
400
401 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
402 id, config_flags, 2, 'cbmz_addemiss_biobb', &
403 dtstep, efact1, dz8w, chem, chem_sum, &
404 ids,ide, jds,jde, kds,kde, &
405 ims,ime, jms,jme, kms,kme, &
406 its,ite, jts,jte, kts,kte, &
407 1, &
408 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
409 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
410 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso )
411
412 end if
413
414
415 END subroutine cbmz_addemiss_bio
416
417
418 END MODULE module_cbmz_addemiss
419
420
421