emissions_driver.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:CHEMICS
2 !
3 subroutine emissions_driver(id,ktau,dtstep,DX, &
4 config_flags, stepbioe,gmt,julday,alt,t_phy,moist,p8w,t8w, &
5 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 u10,v10,ivgtyp,gsw,vegfra,rmol,ust,znt, &
11 xland,xlat,xlong,z_at_w, &
12 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
13 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
14 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
15 noag_grow,noag_nongrow,nononag,slai, &
16 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
17 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
18 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
19 numgas, &
20 ids,ide, jds,jde, kds,kde, &
21 ims,ime, jms,jme, kms,kme, &
22 its,ite, jts,jte, kts,kte )
23 !----------------------------------------------------------------------
24 USE module_configure
25 USE module_state_description
26 USE module_data_radm2
27 USE module_emissions_anthropogenics
28 USE module_bioemi_simple
29 USE module_bioemi_beis311
30 USE module_cbmz_addemiss
31 USE module_mosaic_addemiss
32 IMPLICIT NONE
33
34 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
35
36 INTEGER, INTENT(IN ) :: id,julday, ne_area, &
37 numgas, &
38 ids,ide, jds,jde, kds,kde, &
39 ims,ime, jms,jme, kms,kme, &
40 its,ite, jts,jte, kts,kte
41 INTEGER, INTENT(IN ) :: &
42 ktau,stepbioe
43 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
44 INTENT(IN ) :: moist
45 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
46 INTENT(INOUT ) :: chem
47 REAL, DIMENSION( ims:ime, jms:jme, ne_area ), &
48 INTENT(INOUT ) :: e_bio
49 ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
50 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
51 INTENT(IN ) :: &
52 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2, &
53 e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25, &
54 e_pm10,e_nh3,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2, &
55 e_ch3oh,e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc
56 !
57 !
58 !
59 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
60 INTENT(IN ) :: &
61 alt, &
62 t_phy, &
63 p_phy, &
64 dz8w, &
65 t8w,p8w,z_at_w , &
66 rho_phy
67 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
68 INTENT(IN ) :: &
69 ivgtyp
70 REAL, DIMENSION( ims:ime , jms:jme ) , &
71 INTENT(IN ) :: &
72 u10, &
73 v10, &
74 gsw, &
75 vegfra, &
76 rmol, &
77 ust, &
78 xland, &
79 xlat, &
80 xlong, &
81 znt
82 REAL, DIMENSION( ims:ime , jms:jme ) , &
83 INTENT(INOUT ) :: &
84 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
85 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
86 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
87 noag_grow,noag_nongrow,nononag,slai, &
88 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
89 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
90 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no
91
92 REAL, INTENT(IN ) :: &
93 dtstep,dx,gmt
94 !
95 ! Local variables...
96 !
97 INTEGER :: i, j, k, ksub
98 REAL :: conv
99 CHARACTER (LEN=80) :: message
100
101 ! ..
102 ! ..
103 ! .. Intrinsic Functions ..
104 INTRINSIC max, min
105 ! ..
106 ksub=1
107 #if ( NMM_CORE == 1 )
108 ksub=0
109 #endif
110 bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
111 CASE (GUNTHER1)
112 CALL wrf_debug(15,'biogenic emissions: calling Gunther1')
113 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
114 call bio_emissions(id,ktau,dtstep,DX,config_flags, &
115 gmt,julday,t_phy,moist,p8w,t8w, &
116 e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
117 ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w, &
118 numgas-1, &
119 ids,ide, jds,jde, kds,kde, &
120 ims,ime, jms,jme, kms,kme, &
121 its,ite, jts,jte, kts,kte )
122 endif
123 CASE (BEIS311)
124 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
125 if(config_flags%chem_opt > RACMSORG .AND. config_flags%chem_opt < 100 ) then !<100: kpp mechs, e.g. RACMSORG_KPP
126 CALL wrf_error_fatal( &
127 "emissions_driver: beis3.1.1 biogenic emis. not currently implemented for CBMZ")
128 endif
129 CALL wrf_debug(15,'biogenic emissions: calling beis3.1.1')
130 call bio_emissions_beis311(id,config_flags,ktau,dtstep, &
131 julday,gmt,xlat,xlong,t_phy,p_phy,gsw, &
132 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
133 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
134 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
135 noag_grow,noag_nongrow,nononag,slai, &
136 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
137 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
138 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
139 ids,ide, jds,jde, kds,kde, &
140 ims,ime, jms,jme, kms,kme, &
141 its,ite, jts,jte, kts,kte )
142 endif
143
144 CASE DEFAULT
145 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0) &
146 e_bio(its:ite,jts:jte,1:ne_area) = 0.
147 !wig: May need to zero out all ebio_xxx arrays too if they are incorporated
148 ! into CBMZ/MOSAIC.
149
150 END SELECT bioem_select
151
152 gas_addemiss_select: SELECT CASE(config_flags%chem_opt)
153 CASE (RADM2, RADM2_KPP, RADM2SORG, RACM, RACMSORG,RACM_KPP,RACMSORG_KPP, RACM_MIM_KPP,RADM2SORG_KPP)
154 IF(config_flags%kemit .GT. kte-ksub) THEN
155 message = ' EMISSIONS_DRIVER: KEMIT > KME '
156 k=config_flags%kemit
157 write(0,*)kme,kte-ksub,k
158 CALL WRF_ERROR_FATAL (message)
159 ENDIF
160 call wrf_debug(15,'emissions_driver calling add_anthropogenics')
161 call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem,&
162 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl, &
163 e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2, &
164 e_pm25,e_pm10,e_nh3, &
165 ids,ide, jds,jde, kds,kde, &
166 ims,ime, jms,jme, kms,kme, &
167 its,ite, jts,jte, kts,kte )
168 call wrf_debug(15,'emissions_driver calling add_biogenics')
169 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
170 e_bio,ne_area, &
171 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
172 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
173 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
174 ids,ide, jds,jde, kds,kde, &
175 ims,ime, jms,jme, kms,kme, &
176 its,ite, jts,jte, kts,kte )
177
178 CASE (CBMZ, CBMZ_BB, CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
179 IF(config_flags%kemit .GT. kte-ksub) THEN
180 message = ' EMISSIONS_DRIVER: KEMIT > KME '
181 CALL WRF_ERROR_FATAL (message)
182 ENDIF
183 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_anthro')
184 call cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags, &
185 rho_phy, chem, &
186 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
187 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
188 e_no2,e_ch3oh,e_c2h5oh, &
189 ids,ide, jds,jde, kds,kde, &
190 ims,ime, jms,jme, kms,kme, &
191 its,ite, jts,jte, kts,kte )
192 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_bio')
193 call cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
194 rho_phy, chem, e_bio, ne_area, e_iso, &
195 numgas, &
196 ids,ide, jds,jde, kds,kde, &
197 ims,ime, jms,jme, kms,kme, &
198 its,ite, jts,jte, kts,kte )
199
200 CASE (CHEM_TRACER)
201 do j=jts,jte
202 do i=its,ite
203 do k=kts,min(config_flags%kemit,kte-ksub)
204 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
205 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
206 +e_so2(i,k,j)*conv
207 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
208 +e_co(i,k,j)*conv
209 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
210 +e_co(i,k,j)*conv
211 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
212 +e_co(i,k,j)*conv
213 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
214 +e_co(i,k,j)*conv
215 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
216 +e_co(i,k,j)*conv
217 end do
218 end do
219 end do
220
221 CASE DEFAULT
222 call wrf_debug(15,'emissions_driver NOT CALLING gas add_... routines')
223
224 END SELECT gas_addemiss_select
225
226 aer_addemiss_select: SELECT CASE(config_flags%chem_opt)
227
228 CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
229 call wrf_debug(15,'emissions_driver calling mosaic_addemiss')
230 call mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, &
231 config_flags, chem, &
232 e_pm10,e_pm25,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj, &
233 e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc, &
234 ids,ide, jds,jde, kds,kde, &
235 ims,ime, jms,jme, kms,kme, &
236 its,ite, jts,jte, kts,kte )
237
238 CASE DEFAULT
239 call wrf_debug(15,'emissions_driver NOT CALLING aer add_... routines')
240
241 END SELECT aer_addemiss_select
242
243 END subroutine emissions_driver