dry_dep_driver.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:CHEMICS
2 !
3 subroutine dry_dep_driver(id,ktau,dtstep,config_flags, &
4 gmt,julday,t_phy,moist,scalar,p8w,t8w,w,alt, &
5 p_phy,chem,rho_phy,dz8w,exch_h, &
6 cldfra, cldfra_old, &
7 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
8 ivgtyp,tsk,gsw,vegfra,pbl,rmol,ust,znt,xlat,xlong,z,z_at_w,&
9 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
10 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2,dep_vel_o3, &
11 e_co,kemit,numgas, &
12 ids,ide, jds,jde, kds,kde, &
13 ims,ime, jms,jme, kms,kme, &
14 its,ite, jts,jte, kts,kte )
15 !----------------------------------------------------------------------
16 USE module_model_constants
17 USE module_configure
18 USE module_state_description
19 USE module_dep_simple
20 USE module_vertmx_wrf
21 USE module_data_sorgam
22 USE module_aerosols_sorgam
23 USE module_mosaic_drydep, only: mosaic_drydep_driver
24 USE module_mixactivate_wrappers, only: mosaic_mixactivate, sorgam_mixactivate
25 IMPLICIT NONE
26
27 INTEGER, INTENT(IN ) :: id,julday, &
28 numgas, &
29 ids,ide, jds,jde, kds,kde, &
30 ims,ime, jms,jme, kms,kme, &
31 its,ite, jts,jte, kts,kte
32 INTEGER, INTENT(IN ) :: &
33 ktau
34 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
35 INTENT(IN ) :: moist
36 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_scalar ), &
37 INTENT(INOUT ) :: scalar
38 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
39 INTENT(INOUT ) :: chem
40
41 INTEGER, INTENT(IN ) :: kemit
42 REAL, DIMENSION( ims:ime, kms:kemit, jms:jme ), &
43 INTENT(IN ) :: &
44 e_co
45
46
47
48
49 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
50 INTENT(IN ) :: &
51 t_phy, &
52 alt, &
53 p_phy, &
54 dz8w, &
55 t8w,p8w,z_at_w , &
56 w, &
57 exch_h,rho_phy,z
58 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
59 INTENT(INOUT) :: &
60 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
61 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2
62 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
63 INTENT(IN ) :: &
64 ivgtyp
65 REAL, DIMENSION( ims:ime , jms:jme ) , &
66 INTENT(INOUT) :: &
67 tsk, &
68 gsw, &
69 vegfra, &
70 pbl, &
71 rmol, &
72 ust, &
73 xlat, &
74 xlong, &
75 znt
76 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
77 INTENT(INOUT ) :: &
78 cldfra, & ! cloud fraction current timestep
79 cldfra_old ! cloud fraction previous timestep
80 REAL, DIMENSION( ims:ime , jms:jme ) , &
81 INTENT(OUT) :: &
82 dep_vel_o3
83 REAL, INTENT(OUT), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
84 ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
85
86 REAL, INTENT(IN ) :: &
87 dtstep,gmt
88
89 !--- deposition and emissions stuff
90 ! .. Parameters ..
91 ! ..
92 ! .. Local Scalars ..
93 REAL :: clwchem, dvfog, dvpart, &
94 rad, rhchem, ta, ustar, vegfrac, z1,zntt
95
96 INTEGER :: iland, iprt, iseason, jce, jcs, &
97 n, nr, ipr, jpr, nvr, &
98 idrydep_onoff
99
100 LOGICAL :: highnh3, rainflag, vegflag, wetflag
101 ! CHARACTER (4) :: luse_typ,mminlu_loc
102 ! ..
103 ! .. Local Arrays ..
104 REAL :: p(kts:kte-1)
105 REAL, DIMENSION( its:ite, jts:jte, num_chem ) :: ddvel
106
107 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: dryrho_phy
108 REAL, DIMENSION( kms:kme ) :: dryrho_1d
109
110 ! turbulent transport
111 real :: pblst(kts:kte-1),ekmfull(kts:kte),zzfull(kts:kte),zz(kts:kte-1)
112 integer :: ii,jj,kk,i,j,k,nv
113 !
114 ! necessary for aerosols (module dependent)
115 !
116 REAL, DIMENSION( its:ite, jts:jte ) :: aer_res
117
118 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
119
120
121 ! ..
122 ! .. Intrinsic Functions ..
123 INTRINSIC max, min
124
125 !
126 ! compute dry deposition velocities = ddvel
127 !
128 ! 28-jun-2005 rce - initialize ddvel=0; call aerosol drydep routine
129 ! only when drydep_opt == WESELY
130 ! the wesely_driver routine computes aer_res, and currently
131 ! you cannot compute aerosol drydep without it !!
132 ! 08-jul-2005 rce - pass idrydep_onoff to mixactivate routines
133 !
134 ddvel(:,:,:) = 0.0
135 idrydep_onoff = 0
136
137 drydep_select: SELECT CASE(config_flags%drydep_opt)
138
139 CASE ( WESELY )
140 !
141 ! drydep_opt == WESELY means
142 ! wesely for gases
143 ! other (appropriate) routine for aerosols
144 !
145 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES WITH WESELY METHOD')
146
147 IF( config_flags%chem_opt /= CHEM_TRACER ) THEN
148 call wesely_driver(id,ktau,dtstep, &
149 config_flags, &
150 gmt,julday,t_phy,moist,p8w,t8w, &
151 p_phy,chem,rho_phy,dz8w,ddvel,aer_res, &
152 ivgtyp,tsk,gsw,vegfra,pbl,rmol,ust,znt,xlat,xlong,z,z_at_w,&
153 numgas, &
154 ids,ide, jds,jde, kds,kde, &
155 ims,ime, jms,jme, kms,kme, &
156 its,ite, jts,jte, kts,kte )
157 ELSE
158 !Set dry deposition velocity to zero when using the
159 !chemistry tracer mode.
160 ddvel(:,:,:) = 0.
161 END IF
162
163 idrydep_onoff = 1
164
165
166 adrydep_select: SELECT CASE(config_flags%chem_opt)
167 CASE (RADM2SORG,RADM2SORG_AQ,RADM2SORG_KPP)
168 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR AEROSOLS/RADM')
169 call sorgam_depdriver (id,ktau,dtstep, &
170 ust,t_phy,moist,p8w,t8w, &
171 alt,p_phy,chem,rho_phy,dz8w,z,z_at_w, &
172 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
173 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2, &
174 aer_res,ddvel(:,:,numgas+1:num_chem), &
175 num_chem-numgas, &
176 ids,ide, jds,jde, kds,kde, &
177 ims,ime, jms,jme, kms,kme, &
178 its,ite, jts,jte, kts,kte )
179 CASE (RACMSORG,RACMSORG_AQ,RACMSORG_KPP)
180 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR AEROSOLS/RACM')
181 call sorgam_depdriver (id,ktau,dtstep, &
182 ust,t_phy,moist,p8w,t8w, &
183 alt,p_phy,chem,rho_phy,dz8w,z,z_at_w, &
184 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
185 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2, &
186 aer_res,ddvel(:,:,numgas+1:num_chem), &
187 num_chem-numgas, &
188 ids,ide, jds,jde, kds,kde, &
189 ims,ime, jms,jme, kms,kme, &
190 its,ite, jts,jte, kts,kte )
191 CASE ( CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ )
192 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR MOSAIC AEROSOLS')
193 call mosaic_drydep_driver( &
194 id, ktau, dtstep, config_flags, &
195 gmt, julday, &
196 t_phy, rho_phy, p_phy, &
197 ust, aer_res, &
198 moist, chem, ddvel, &
199 ids,ide, jds,jde, kds,kde, &
200 ims,ime, jms,jme, kms,kme, &
201 its,ite, jts,jte, kts,kte )
202 CASE DEFAULT
203
204 END SELECT adrydep_select
205
206 CASE DEFAULT
207
208 END SELECT drydep_select
209
210
211
212 ! This will be called later from subgrd_transport_driver.F !!!!!!!!
213 !
214 !
215 dep_vel_o3=0.
216 do 100 j=jts,jte
217 do 100 i=its,ite
218 pblst=0.
219 !
220 !
221 !-- start with vertical mixing
222 !
223 do k=kts,kte
224 zzfull(k)=z_at_w(i,k,j)-z_at_w(i,kts,j)
225 ekmfull(k)=max(1.e-6,exch_h(i,k,j))
226 enddo
227
228 !!$! UNCOMMENT THIS AND FINE TUNE LEVELS TO YOUR DOMAIN IF YOU WANT TO
229 !!$! FORCE MIXING TO A CERTAIN DEPTH:
230 !!$!
231 !!$! --- Mix the emissions up several layers
232 !!$! if e_co > 0., the grid cell should not be over water
233 !!$! if e_co > 200, the grid cell should be over a large urban region
234 !!$!
235 ! if (e_co(i,kts,j) .gt. 0) then
236 ! ekmfull(kts:kts+10) = max(ekmfull(kts:kts+10),1.)
237 ! endif
238 ! if (e_co(i,kts,j) .gt. 200) then
239 ! ekmfull(kts:kte/2) = max(ekmfull(kts:kte/2),2.)
240 ! endif
241 !!$!
242 !
243 !
244 do k=kts,kte-1
245 zz(k)=z(i,k,j)-z_at_w(i,kts,j)
246 enddo
247 ekmfull(kts)=0.
248 ekmfull(kte)=0.
249 !
250 ! vertical mixing routine (including deposition)
251 ! need to be careful here with that dumm tracer in spot 1
252 ! do not need lho,lho2
253 ! (03-may-2006 rce - calc dryrho_1d and pass it to vertmx)
254 !
255 dep_vel_o3(i,j)=ddvel(i,j,p_o3)
256 do nv=2,num_chem-0
257 do k=kts,kte-1
258 ! pblst(k)=max(epsilc,chem(i,k,j,nv))
259 pblst(k)=max(epsilc,chem(i,k,j,nv)/alt(i,k,j))
260 dryrho_1d(k) = 1./alt(i,k,j)
261 enddo
262 ! if(ktau.ge.20)then
263 ! write(0,*)i,j,nv,ddvel(i,j,nv),e_co(i,kts,j)
264 ! endif
265
266 mix_select: SELECT CASE(config_flags%chem_opt)
267 CASE (RADM2SORG_AQ, RACMSORG_AQ, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
268 if(.not.is_aerosol(nv))then ! mix gases not aerosol
269 ! call vertmx(dtstep,pblst,ekmfull,dryrho_1d, &
270 ! zzfull,zz,ddvel(i,j,nv),kts,kte-1)
271 call vertmx(dtstep,pblst,ekmfull,zzfull,zz,ddvel(i,j,nv),kts,kte-1)
272
273 endif
274 ! CASE (PRESCRIBE_AEROSOL)
275
276 CASE DEFAULT
277 call vertmx(dtstep,pblst,ekmfull,zzfull,zz,ddvel(i,j,nv),kts,kte-1)
278
279 END SELECT mix_select
280
281 do k=kts,kte-2
282
283 ! chem(i,k,j,nv)=max(epsilc,pblst(k))
284 chem(i,k,j,nv)=max(epsilc,pblst(k)*alt(i,k,j))
285 enddo
286 enddo
287 100 continue
288 !
289 ! vertical mixing and activation of aerosol
290 !
291 where( alt(its:ite,kts:kte,jts:jte) /= 0. ) !get dry density to conserve mass in mixactivate, wig, 24-apr-2006
292 dryrho_phy(its:ite,kts:kte,jts:jte) = 1./alt(its:ite,kts:kte,jts:jte)
293 dryrho_phy(its:ite,kts:kte,jts:jte) = 1.
294 elsewhere
295 dryrho_phy(its:ite,kts:kte,jts:jte) = 0.
296 end where
297
298 mixactivate_select: SELECT CASE(config_flags%chem_opt)
299
300 CASE (RADM2SORG_AQ, RACMSORG_AQ)
301 call sorgam_mixactivate ( &
302 id, ktau, dtstep, config_flags, idrydep_onoff, &
303 dryrho_phy, t_phy, w, cldfra, cldfra_old, &
304 ddvel, z, dz8w, p8w, t8w, exch_h, &
305 moist(ims,kms,jms,P_QV), moist(ims,kms,jms,P_QC), moist(ims,kms,jms,P_QI), &
306 scalar(ims,kms,jms,P_QNDROP), f_qc, f_qi, chem, &
307 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
308 ims,ime, jms,jme, kms,kme, &
309 its,ite, jts,jte, kts,kte )
310 CASE (CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
311 CALL wrf_debug(15,'call mixactive for mosaic aerosol')
312 call mosaic_mixactivate ( &
313 id, ktau, dtstep, config_flags, idrydep_onoff, &
314 dryrho_phy, t_phy, w, cldfra, cldfra_old, &
315 ddvel, z, dz8w, p8w, t8w, exch_h, &
316 moist(ims,kms,jms,P_QV), moist(ims,kms,jms,P_QC), moist(ims,kms,jms,P_QI), &
317 scalar(ims,kms,jms,P_QNDROP), f_qc, f_qi, chem, &
318 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
319 ims,ime, jms,jme, kms,kme, &
320 its,ite, jts,jte, kts,kte )
321 CASE DEFAULT
322 END SELECT mixactivate_select
323 CALL wrf_debug(15,'end of dry_dep_driver')
324
325 END SUBROUTINE dry_dep_driver