module_emissions_anthropogenics.F
References to this file elsewhere.
1 MODULE module_emissions_anthropogenics
2 !WRF:MODEL_LAYER:CHEMICS
3 !
4 CONTAINS
5 !
6 ! currently this only adds in the emissions...
7 ! this may be done differently for different chemical mechanisms
8 ! in the future. aerosols are already added somewhere else....
9 !
10 subroutine add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem, &
11 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl, &
12 e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2, &
13 e_pm25,e_pm10,e_nh3, &
14 ids,ide, jds,jde, kds,kde, &
15 ims,ime, jms,jme, kms,kme, &
16 its,ite, jts,jte, kts,kte )
17 !----------------------------------------------------------------------
18 USE module_configure
19 USE module_state_description
20 USE module_data_radm2
21 IMPLICIT NONE
22
23 ! .. Parameters ..
24 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
25
26 INTEGER, INTENT(IN ) :: id, &
27 ids,ide, jds,jde, kds,kde, &
28 ims,ime, jms,jme, kms,kme, &
29 its,ite, jts,jte, kts,kte
30 REAL, INTENT(IN ) :: &
31 dtstep
32 !
33 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
34 INTENT(INOUT ) :: chem
35 !
36 ! emissions arrays
37 !
38 ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
39 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
40 INTENT(IN ) :: &
41 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,&
42 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3
43 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
44 INTENT(IN ) :: rho_phy
45
46 !
47 !
48 !
49
50
51 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
52 INTENT(IN ) :: &
53 dz8w
54 integer i,j,k
55 real :: conv_rho
56 !--- deposition and emissions stuff
57
58
59 ! ..
60 ! ..
61 ! .. Intrinsic Functions ..
62
63 call wrf_debug(15,'add_anhropogenics')
64 !
65 ! add emissions
66 !
67 do 100 j=jts,jte
68 do 100 i=its,ite
69
70 DO k=kts,min(config_flags%kemit,kte-1)
71 conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
72
73 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
74 if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. &
75 (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. &
76 (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K) ) then
77 print*
78 print*,"Converted emissions for RADM2:"
79 print*,"e_csl=",e_csl(i,k,j)*conv_rho
80 print*,"e_iso=",e_iso(i,k,j)*conv_rho
81 print*,"e_so2=",e_so2(i,k,j)*conv_rho
82 print*,"e_no=",e_no(i,k,j)*conv_rho
83 print*,"e_ald=",e_ald(i,k,j)*conv_rho
84 print*,"e_hcho=",e_hcho(i,k,j)*conv_rho
85 print*,"e_ora2=",e_ora2(i,k,j)*conv_rho
86 print*,"e_nh3=",e_nh3(i,k,j)*conv_rho
87 print*,"e_hc3=",e_hc3(i,k,j)*conv_rho
88 print*,"e_hc5=",e_hc5(i,k,j)*conv_rho
89 print*,"e_hc8=",e_hc8(i,k,j)*conv_rho
90 print*,"e_eth=",e_eth(i,k,j)*conv_rho
91 print*,"e_co=",e_co(i,k,j)*conv_rho
92 print*,"e_ol2=",e_ol2(i,k,j)*conv_rho
93 print*,"e_olt=",e_olt(i,k,j)*conv_rho
94 print*,"e_oli=",e_oli(i,k,j)*conv_rho
95 print*,"e_tol=",e_tol(i,k,j)*conv_rho
96 print*,"e_xyl=",e_xyl(i,k,j)*conv_rho
97 print*,"e_ket=",e_ket(i,k,j)*conv_rho
98 end if
99 #endif
100
101 chem(i,k,j,p_csl) = chem(i,k,j,p_csl) &
102 +e_csl(i,k,j)*conv_rho
103 chem(i,k,j,p_iso) = chem(i,k,j,p_iso) &
104 +e_iso(i,k,j)*conv_rho
105 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
106 +e_so2(i,k,j)*conv_rho
107 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
108 +e_no(i,k,j)*conv_rho
109 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
110 +e_ald(i,k,j)*conv_rho
111 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
112 +e_hcho(i,k,j)*conv_rho
113 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
114 +e_ora2(i,k,j)*conv_rho
115 chem(i,k,j,p_nh3) = chem(i,k,j,p_nh3) &
116 +e_nh3(i,k,j)*conv_rho
117 chem(i,k,j,p_hc3) = chem(i,k,j,p_hc3) &
118 +e_hc3(i,k,j)*conv_rho
119 chem(i,k,j,p_hc5) = chem(i,k,j,p_hc5) &
120 +e_hc5(i,k,j)*conv_rho
121 chem(i,k,j,p_hc8) = chem(i,k,j,p_hc8) &
122 +e_hc8(i,k,j)*conv_rho
123 chem(i,k,j,p_eth) = chem(i,k,j,p_eth) &
124 +e_eth(i,k,j)*conv_rho
125 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
126 +e_co(i,k,j)*conv_rho
127 if(p_ol2.gt.1)chem(i,k,j,p_ol2) = chem(i,k,j,p_ol2) &
128 +e_ol2(i,k,j)*conv_rho
129 if(p_ete.gt.1)chem(i,k,j,p_ete) = chem(i,k,j,p_ete) &
130 +e_ol2(i,k,j)*conv_rho
131 chem(i,k,j,p_olt) = chem(i,k,j,p_olt) &
132 +e_olt(i,k,j)*conv_rho
133 chem(i,k,j,p_oli) = chem(i,k,j,p_oli) &
134 +e_oli(i,k,j)*conv_rho
135 chem(i,k,j,p_tol) = chem(i,k,j,p_tol) &
136 +e_tol(i,k,j)*conv_rho
137 chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) &
138 +e_xyl(i,k,j)*conv_rho
139 chem(i,k,j,p_ket) = chem(i,k,j,p_ket) &
140 +e_ket(i,k,j)*conv_rho
141 END DO
142 100 continue
143
144 END subroutine add_anthropogenics
145 !
146 !
147 subroutine add_biogenics(id,dtstep,dz8w,config_flags,rho_phy,chem, &
148 e_bio,ne_area, &
149 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
150 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
151 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
152 ids,ide, jds,jde, kds,kde, &
153 ims,ime, jms,jme, kms,kme, &
154 its,ite, jts,jte, kts,kte )
155 USE module_configure
156 USE module_state_description
157 USE module_data_radm2
158 USE module_aerosols_sorgam
159 IMPLICIT NONE
160 INTEGER, INTENT(IN ) :: id,ne_area, &
161 ids,ide, jds,jde, kds,kde, &
162 ims,ime, jms,jme, kms,kme, &
163 its,ite, jts,jte, kts,kte
164 REAL, INTENT(IN ) :: &
165 dtstep
166 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
167 INTENT(INOUT ) :: chem
168 REAL, DIMENSION( ims:ime, jms:jme,ne_area ), &
169 INTENT(IN ) :: &
170 e_bio
171 REAL, DIMENSION( ims:ime, jms:jme ), &
172 INTENT(IN ) :: &
173 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
174 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
175 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no
176
177 !
178 !
179 !
180
181 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
182 INTENT(IN ) :: &
183 rho_phy,dz8w
184 integer i,j,k,n
185 real :: conv_rho
186 !--- deposition and emissions stuff
187 ! .. Parameters ..
188 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
189 ! return
190 bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
191 CASE (GUNTHER1)
192 CALL wrf_debug(15,'adding biogenic emissions: Gunther1')
193 ! DO n = 1, numgas-2
194 do 100 j=jts,jte
195 do 100 i=its,ite
196 conv_rho=dtstep/(dz8w(i,kts,j)*60.)
197 chem(i,kts,j,p_iso)=chem(i,kts,j,p_iso)+ &
198 e_bio(i,j,p_iso-1)*conv_rho
199 chem(i,kts,j,p_oli)=chem(i,kts,j,p_oli)+ &
200 e_bio(i,j,p_oli-1)*conv_rho
201 chem(i,kts,j,p_xyl)=chem(i,kts,j,p_xyl)+ &
202 e_bio(i,j,p_xyl-1)*conv_rho
203 chem(i,kts,j,p_hc3)=chem(i,kts,j,p_hc3)+ &
204 e_bio(i,j,p_hc3-1)*conv_rho
205 chem(i,kts,j,p_olt)=chem(i,kts,j,p_olt)+ &
206 e_bio(i,j,p_olt-1)*conv_rho
207 chem(i,kts,j,p_ket)=chem(i,kts,j,p_ket)+ &
208 e_bio(i,j,p_ket-1)*conv_rho
209 chem(i,kts,j,p_ald)=chem(i,kts,j,p_ald)+ &
210 e_bio(i,j,p_ald-1)*conv_rho
211 chem(i,kts,j,p_hcho)=chem(i,kts,j,p_hcho)+ &
212 e_bio(i,j,p_hcho-1)*conv_rho
213 chem(i,kts,j,p_eth)=chem(i,kts,j,p_eth)+ &
214 e_bio(i,j,p_eth-1)*conv_rho
215 chem(i,kts,j,p_ora2)=chem(i,kts,j,p_ora2)+ &
216 e_bio(i,j,p_ora2-1)*conv_rho
217 chem(i,kts,j,p_co)=chem(i,kts,j,p_co)+ &
218 e_bio(i,j,p_co-1)*conv_rho
219 chem(i,kts,j,p_no)=chem(i,kts,j,p_no)+ &
220 e_bio(i,j,p_no-1)*conv_rho
221 !
222 ! RADM only
223 !
224 if(p_ol2.gt.1)chem(i,kts,j,p_ol2)=chem(i,kts,j,p_ol2)+ &
225 e_bio(i,j,p_ol2-1)*conv_rho
226 100 continue
227 ! enddo
228 CASE (BEIS311)
229 CALL wrf_debug(100,'adding biogenic emissions: beis3.1.1')
230 do j=jts,jte
231 do i=its,ite
232 conv_rho=4.828e-4/rho_phy(i,kts,j)*dtstep/(dz8w(i,kts,j)*60.)
233 chem(i,kts,j,p_iso)=chem(i,kts,j,p_iso)+ &
234 ebio_iso(i,j)*conv_rho
235 chem(i,kts,j,p_oli)=chem(i,kts,j,p_oli)+ &
236 ebio_oli(i,j)*conv_rho
237 chem(i,kts,j,p_xyl)=chem(i,kts,j,p_xyl)+ &
238 ebio_xyl(i,j)*conv_rho
239 chem(i,kts,j,p_hc3)=chem(i,kts,j,p_hc3)+ &
240 ebio_hc3(i,j)*conv_rho
241 chem(i,kts,j,p_olt)=chem(i,kts,j,p_olt)+ &
242 ebio_olt(i,j)*conv_rho
243 chem(i,kts,j,p_ket)=chem(i,kts,j,p_ket)+ &
244 ebio_ket(i,j)*conv_rho
245 chem(i,kts,j,p_ald)=chem(i,kts,j,p_ald)+ &
246 ebio_ald(i,j)*conv_rho
247 chem(i,kts,j,p_hcho)=chem(i,kts,j,p_hcho)+ &
248 ebio_hcho(i,j)*conv_rho
249 chem(i,kts,j,p_eth)=chem(i,kts,j,p_eth)+ &
250 ebio_eth(i,j)*conv_rho
251 chem(i,kts,j,p_ora2)=chem(i,kts,j,p_ora2)+ &
252 ebio_ora2(i,j)*conv_rho
253 chem(i,kts,j,p_co)=chem(i,kts,j,p_co)+ &
254 ebio_co(i,j)*conv_rho
255 chem(i,kts,j,p_no)=chem(i,kts,j,p_no)+ &
256 ebio_no(i,j)*conv_rho
257 !
258 ! RADM only
259 !
260 if(p_ol2.gt.1)chem(i,kts,j,p_ol2)=chem(i,kts,j,p_ol2)+ &
261 ebio_ete(i,j)*conv_rho
262 !
263 ! RACM only
264 !
265 if(p_api.gt.1)chem(i,kts,j,p_api)=chem(i,kts,j,p_api)+ &
266 ebio_api(i,j)*conv_rho
267 if(p_lim.gt.1)chem(i,kts,j,p_lim)=chem(i,kts,j,p_lim)+ &
268 ebio_lim(i,j)*conv_rho
269 if(p_ete.gt.1)chem(i,kts,j,p_ete)=chem(i,kts,j,p_ete)+ &
270 ebio_ete(i,j)*conv_rho
271 enddo
272 enddo
273 CASE DEFAULT
274
275 END SELECT bioem_select
276 END subroutine add_biogenics
277
278
279 END MODULE module_emissions_anthropogenics