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-1)
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_hc3) = chem(i,k,j,p_hc3) &
144 +e_hc3(i,k,j)*conv
145 chem(i,k,j,p_hc5) = chem(i,k,j,p_hc5) &
146 +e_hc5(i,k,j)*conv
147 chem(i,k,j,p_hc8) = chem(i,k,j,p_hc8) &
148 +e_hc8(i,k,j)*conv
149 chem(i,k,j,p_eth) = chem(i,k,j,p_eth) &
150 +e_eth(i,k,j)*conv
151 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
152 +e_co(i,k,j)*conv
153 chem(i,k,j,p_ol2) = chem(i,k,j,p_ol2) &
154 +e_ol2(i,k,j)*conv
155 chem(i,k,j,p_olt) = chem(i,k,j,p_olt) &
156 +e_olt(i,k,j)*conv
157 chem(i,k,j,p_oli) = chem(i,k,j,p_oli) &
158 +e_oli(i,k,j)*conv
159 chem(i,k,j,p_tol) = chem(i,k,j,p_tol) &
160 +e_tol(i,k,j)*conv
161 chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) &
162 +e_xyl(i,k,j)*conv
163 chem(i,k,j,p_ket) = chem(i,k,j,p_ket) &
164 +e_ket(i,k,j)*conv
165
166 ! when emissions input file is "radm2sorg" variety, calc par emissions as a
167 ! combination of the anthropogenic emissions for radm2 primary voc species
168 if ( (config_flags%emiss_inpt_opt == EMISS_INPT_DEFAULT) .or. &
169 (config_flags%emiss_inpt_opt == EMISS_INPT_PNNL_RS) ) then
170 chem(i,k,j,p_par) = chem(i,k,j,p_par) &
171 + conv* &
172 ( 0.4*e_ald(i,k,j) + 2.9*e_hc3(i,k,j) &
173 + 4.8*e_hc5(i,k,j) + 7.9*e_hc8(i,k,j) &
174 + 0.9*e_ket(i,k,j) + 2.8*e_oli(i,k,j) &
175 + 1.8*e_olt(i,k,j) + 1.0*e_ora2(i,k,j) )
176
177 ! when emissions input file is "cbmzmosaic" variety,
178 ! the par emissions are read into e_hc5
179 ! and there are emissions for other species
180 else
181 chem(i,k,j,p_par) = chem(i,k,j,p_par) &
182 + conv*e_hc5(i,k,j)
183
184 chem(i,k,j,p_no2) = chem(i,k,j,p_no2) &
185 + conv*e_no2(i,k,j)
186 chem(i,k,j,p_ch3oh) = chem(i,k,j,p_ch3oh) &
187 + conv*e_ch3oh(i,k,j)
188 chem(i,k,j,p_c2h5oh) = chem(i,k,j,p_c2h5oh) &
189 + conv*e_c2h5oh(i,k,j)
190 end if
191
192 END DO
193 100 continue
194
195
196 ! do mass check final calc
197 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
198 id, config_flags, 2, 'cbmz_addemiss', &
199 dtstep, efact1, dz8w, chem, chem_sum, &
200 ids,ide, jds,jde, kds,kde, &
201 ims,ime, jms,jme, kms,kme, &
202 its,ite, jts,jte, kts,kte, &
203 21, &
204 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_nh3, &
206 e_no2,e_ch3oh,e_c2h5oh )
207
208
209 END subroutine cbmz_addemiss_anthro
210
211
212
213 !----------------------------------------------------------------------
214 subroutine cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
215 rho_phy, chem, e_bio, ne_area, e_iso, &
216 numgas, &
217 ids,ide, jds,jde, kds,kde, &
218 ims,ime, jms,jme, kms,kme, &
219 its,ite, jts,jte, kts,kte )
220
221 USE module_configure
222 USE module_state_description
223 USE module_data_radm2
224 USE module_aerosols_sorgam
225
226 IMPLICIT NONE
227
228 ! subr arguments
229 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
230
231 INTEGER, INTENT(IN ) :: id, ne_area, &
232 numgas, &
233 ids,ide, jds,jde, kds,kde, &
234 ims,ime, jms,jme, kms,kme, &
235 its,ite, jts,jte, kts,kte
236
237 REAL, INTENT(IN ) :: dtstep
238
239 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
240 INTENT(INOUT ) :: chem
241
242 REAL, DIMENSION( ims:ime, jms:jme,ne_area ), &
243 INTENT(IN ) :: e_bio
244
245 ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
246 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
247 INTENT(IN ) :: e_iso
248
249 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
250 INTENT(IN ) :: dz8w, rho_phy
251
252
253 ! local variables
254 integer i,j,k,n
255 real, parameter :: efact1 = 1.0/60.0
256 double precision :: chem_sum(num_chem)
257
258
259 !
260 ! apply gunther online biogenic gas emissions when bio_emiss_opt == GUNTHER1
261 !
262 if (config_flags%bio_emiss_opt == GUNTHER1) then
263
264 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
265 id, config_flags, 1, 'cbmz_addemiss_bioaa', &
266 dtstep, efact1, dz8w, chem, chem_sum, &
267 ids,ide, jds,jde, kds,kde, &
268 ims,ime, jms,jme, kms,kme, &
269 its,ite, jts,jte, kts,kte, &
270 kms, 13, &
271 e_bio(ims,jms,p_ald-1), e_bio(ims,jms,p_hc3-1), &
272 e_bio(ims,jms,p_hc5-1), e_bio(ims,jms,p_hc8-1), &
273 e_bio(ims,jms,p_hcho-1), e_bio(ims,jms,p_iso-1), &
274 e_bio(ims,jms,p_ket-1), e_bio(ims,jms,p_no-1), &
275 e_bio(ims,jms,p_oli-1), e_bio(ims,jms,p_olt-1), &
276 e_bio(ims,jms,p_ora1-1), e_bio(ims,jms,p_ora2-1), &
277 e_bio(ims,jms,p_xyl-1), &
278 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
279 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
280 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
281 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1) )
282
283 DO n = 1, ne_area-2 !Assumes CBMZ and RADM2 species locations match up to p_iso
284 do 100 j=jts,jte
285 do 100 i=its,ite
286 chem(i,kts,j,n+1) = chem(i,kts,j,n+1) &
287 + e_bio(i,j,n)/(dz8w(i,kts,j)*60.)*dtstep
288 100 continue
289 enddo
290
291 ! calc par emissions as a combination of the biogenic emissions
292 ! for radm2 primary voc species
293 do j = jts, jte
294 do i = its, ite
295 chem(i,kts,j,p_par) = chem(i,kts,j,p_par) &
296 + (dtstep/(dz8w(i,kts,j)*60.))* &
297 ( 0.4*e_bio(i,j,p_ald-1) + 2.9*e_bio(i,j,p_hc3-1) &
298 + 4.8*e_bio(i,j,p_hc5-1) + 7.9*e_bio(i,j,p_hc8-1) &
299 + 0.9*e_bio(i,j,p_ket-1) + 2.8*e_bio(i,j,p_oli-1) &
300 + 1.8*e_bio(i,j,p_olt-1) + 1.0*e_bio(i,j,p_ora2-1) )
301 end do
302 end do
303
304 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
305 id, config_flags, 2, 'cbmz_addemiss_bioaa', &
306 dtstep, efact1, dz8w, chem, chem_sum, &
307 ids,ide, jds,jde, kds,kde, &
308 ims,ime, jms,jme, kms,kme, &
309 its,ite, jts,jte, kts,kte, &
310 kms, 13, &
311 e_bio(ims,jms,p_ald-1), e_bio(ims,jms,p_hc3-1), &
312 e_bio(ims,jms,p_hc5-1), e_bio(ims,jms,p_hc8-1), &
313 e_bio(ims,jms,p_hcho-1), e_bio(ims,jms,p_iso-1), &
314 e_bio(ims,jms,p_ket-1), e_bio(ims,jms,p_no-1), &
315 e_bio(ims,jms,p_oli-1), e_bio(ims,jms,p_olt-1), &
316 e_bio(ims,jms,p_ora1-1), e_bio(ims,jms,p_ora2-1), &
317 e_bio(ims,jms,p_xyl-1), &
318 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
319 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
320 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1), &
321 e_bio(ims,jms,p_xyl-1), e_bio(ims,jms,p_xyl-1) )
322
323 end if
324
325
326 !
327 ! apply offline isoprene emissions when bio_emiss_opt /= GUNTHER1
328 !
329 if (config_flags%bio_emiss_opt /= GUNTHER1) then
330
331 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
332 id, config_flags, 1, 'cbmz_addemiss_biobb', &
333 dtstep, efact1, dz8w, chem, chem_sum, &
334 ids,ide, jds,jde, kds,kde, &
335 ims,ime, jms,jme, kms,kme, &
336 its,ite, jts,jte, kts,kte, &
337 1, &
338 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
339 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
340 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso )
341
342 do j = jts, jte
343 do k = kts, min(config_flags%kemit,kte-1)
344 do i = its, ite
345 chem(i,k,j,p_iso) = chem(i,k,j,p_iso) + e_iso(i,k,j) &
346 *4.828e-4/rho_phy(i,k,j)*(dtstep/(dz8w(i,k,j)*60.))
347 end do
348 end do
349 end do
350
351 if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck( &
352 id, config_flags, 2, 'cbmz_addemiss_biobb', &
353 dtstep, efact1, dz8w, chem, chem_sum, &
354 ids,ide, jds,jde, kds,kde, &
355 ims,ime, jms,jme, kms,kme, &
356 its,ite, jts,jte, kts,kte, &
357 1, &
358 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
359 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso, &
360 e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso )
361
362 end if
363
364
365 END subroutine cbmz_addemiss_bio
366
367
368 END MODULE module_cbmz_addemiss
369
370
371