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
98 REAL :: conv
99 CHARACTER (LEN=80) :: message
100
101 ! ..
102 ! ..
103 ! .. Intrinsic Functions ..
104 INTRINSIC max, min
105 ! ..
106 bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
107 CASE (GUNTHER1)
108 CALL wrf_debug(15,'biogenic emissions: calling Gunther1')
109 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
110 call bio_emissions(id,ktau,dtstep,DX,config_flags, &
111 gmt,julday,t_phy,moist,p8w,t8w, &
112 e_bio,p_phy,chem,rho_phy,dz8w,ne_area, &
113 ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w, &
114 numgas-1, &
115 ids,ide, jds,jde, kds,kde, &
116 ims,ime, jms,jme, kms,kme, &
117 its,ite, jts,jte, kts,kte )
118 endif
119 CASE (BEIS311)
120 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
121 if(config_flags%chem_opt > RACMSORG .AND. config_flags%chem_opt < 100 ) then !<100: kpp mechs, e.g. RACMSORG_KPP
122 CALL wrf_error_fatal( &
123 "emissions_driver: beis3.1.1 biogenic emis. not currently implemented for CBMZ")
124 endif
125 CALL wrf_debug(15,'biogenic emissions: calling beis3.1.1')
126 call bio_emissions_beis311(id,config_flags,ktau,dtstep, &
127 julday,gmt,xlat,xlong,t_phy,p_phy,gsw, &
128 sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl, &
129 sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald, &
130 sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr, &
131 noag_grow,noag_nongrow,nononag,slai, &
132 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
133 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
134 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
135 ids,ide, jds,jde, kds,kde, &
136 ims,ime, jms,jme, kms,kme, &
137 its,ite, jts,jte, kts,kte )
138 endif
139
140 CASE DEFAULT
141 if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0) &
142 e_bio(its:ite,jts:jte,1:ne_area) = 0.
143 !wig: May need to zero out all ebio_xxx arrays too if they are incorporated
144 ! into CBMZ/MOSAIC.
145
146 END SELECT bioem_select
147
148 gas_addemiss_select: SELECT CASE(config_flags%chem_opt)
149 CASE (RADM2, RADM2_KPP, RADM2SORG, RACM, RACMSORG,RACM_KPP,RACMSORG_KPP, RACM_MIM_KPP,RADM2SORG_KPP)
150 IF(config_flags%kemit .GT. kte-1) THEN
151 message = ' EMISSIONS_DRIVER: KEMIT > KME '
152 CALL WRF_ERROR_FATAL (message)
153 ENDIF
154 call wrf_debug(15,'emissions_driver calling add_anthropogenics')
155 call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem,&
156 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl, &
157 e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2, &
158 e_pm25,e_pm10,e_nh3, &
159 ids,ide, jds,jde, kds,kde, &
160 ims,ime, jms,jme, kms,kme, &
161 its,ite, jts,jte, kts,kte )
162 call wrf_debug(15,'emissions_driver calling add_biogenics')
163 call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem, &
164 e_bio,ne_area, &
165 ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl, &
166 ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald, &
167 ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no, &
168 ids,ide, jds,jde, kds,kde, &
169 ims,ime, jms,jme, kms,kme, &
170 its,ite, jts,jte, kts,kte )
171
172 CASE (CBMZ, CBMZ_BB, CBMZ_MOSAIC_AA, CBMZ_MOSAIC_BB)
173 IF(config_flags%kemit .GT. kte-1) THEN
174 message = ' EMISSIONS_DRIVER: KEMIT > KME '
175 CALL WRF_ERROR_FATAL (message)
176 ENDIF
177 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_anthro')
178 call cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags, &
179 rho_phy, chem, &
180 e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
181 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3, &
182 e_no2,e_ch3oh,e_c2h5oh, &
183 ids,ide, jds,jde, kds,kde, &
184 ims,ime, jms,jme, kms,kme, &
185 its,ite, jts,jte, kts,kte )
186 call wrf_debug(15,'emissions_driver calling cbmz_addemiss_bio')
187 call cbmz_addemiss_bio( id, dtstep, dz8w, config_flags, &
188 rho_phy, chem, e_bio, ne_area, e_iso, &
189 numgas, &
190 ids,ide, jds,jde, kds,kde, &
191 ims,ime, jms,jme, kms,kme, &
192 its,ite, jts,jte, kts,kte )
193
194 CASE (CHEM_TRACER)
195 do j=jts,jte
196 do i=its,ite
197 do k=kts,min(config_flags%kemit,kte-1)
198 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
199 chem(i,k,j,p_so2) = chem(i,k,j,p_so2) &
200 +e_so2(i,k,j)*conv
201 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
202 +e_co(i,k,j)*conv
203 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
204 +e_co(i,k,j)*conv
205 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
206 +e_co(i,k,j)*conv
207 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
208 +e_co(i,k,j)*conv
209 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
210 +e_co(i,k,j)*conv
211 end do
212 end do
213 end do
214
215 CASE DEFAULT
216 call wrf_debug(15,'emissions_driver NOT CALLING gas add_... routines')
217
218 END SELECT gas_addemiss_select
219
220 aer_addemiss_select: SELECT CASE(config_flags%chem_opt)
221
222 CASE (CBMZ_MOSAIC_AA, CBMZ_MOSAIC_BB)
223 call wrf_debug(15,'emissions_driver calling mosaic_addemiss')
224 call mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, &
225 config_flags, chem, &
226 e_pm10,e_pm25,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj, &
227 e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc, &
228 ids,ide, jds,jde, kds,kde, &
229 ims,ime, jms,jme, kms,kme, &
230 its,ite, jts,jte, kts,kte )
231
232 CASE DEFAULT
233 call wrf_debug(15,'emissions_driver NOT CALLING aer add_... routines')
234
235 END SELECT aer_addemiss_select
236
237 END subroutine emissions_driver