dry_dep_driver.F

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