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,p8w,t8w,alt, &
5 p_phy,chem,rho_phy,dz8w,exch_h, &
6 ivgtyp,tsk,gsw,vegfra,pbl,rmol,ust,znt,xlat,xlong,z,z_at_w,&
7 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
8 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2,dep_vel_o3, &
9 e_co,kemit,numgas, &
10 ids,ide, jds,jde, kds,kde, &
11 ims,ime, jms,jme, kms,kme, &
12 its,ite, jts,jte, kts,kte )
13 !----------------------------------------------------------------------
14 USE module_model_constants
15 USE module_configure
16 USE module_state_description
17 USE module_dep_simple
18 USE module_vertmx_wrf
19 USE module_data_sorgam
20 USE module_aerosols_sorgam
21 USE module_mosaic_drydep, only: mosaic_drydep_driver
22 IMPLICIT NONE
23
24 INTEGER, INTENT(IN ) :: id,julday, &
25 numgas, &
26 ids,ide, jds,jde, kds,kde, &
27 ims,ime, jms,jme, kms,kme, &
28 its,ite, jts,jte, kts,kte
29 INTEGER, INTENT(IN ) :: &
30 ktau
31 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
32 INTENT(IN ) :: moist
33 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
34 INTENT(INOUT ) :: chem
35
36 INTEGER, INTENT(IN ) :: kemit
37 REAL, DIMENSION( ims:ime, kms:kemit, jms:jme ), &
38 INTENT(IN ) :: &
39 e_co
40
41
42
43
44 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
45 INTENT(IN ) :: &
46 t_phy, &
47 alt, &
48 p_phy, &
49 dz8w, &
50 t8w,p8w,z_at_w , &
51 exch_h,rho_phy,z
52 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
53 INTENT(INOUT) :: &
54 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
55 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2
56 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
57 INTENT(IN ) :: &
58 ivgtyp
59 REAL, DIMENSION( ims:ime , jms:jme ) , &
60 INTENT(INOUT) :: &
61 tsk, &
62 gsw, &
63 vegfra, &
64 pbl, &
65 rmol, &
66 ust, &
67 xlat, &
68 xlong, &
69 znt
70 REAL, DIMENSION( ims:ime , jms:jme ) , &
71 INTENT(OUT) :: &
72 dep_vel_o3
73 REAL, INTENT(IN ) :: &
74 dtstep,gmt
75
76 !--- deposition and emissions stuff
77 ! .. Parameters ..
78 ! ..
79 ! .. Local Scalars ..
80 REAL :: clwchem, dvfog, dvpart, &
81 rad, rhchem, ta, ustar, vegfrac, z1,zntt
82
83 INTEGER :: iland, iprt, iseason, jce, jcs, &
84 n, nr, ipr,jpr,nvr
85 LOGICAL :: highnh3, rainflag, vegflag, wetflag
86 ! CHARACTER (4) :: luse_typ,mminlu_loc
87 ! ..
88 ! .. Local Arrays ..
89 REAL :: p(kts:kte-1)
90 REAL, DIMENSION( its:ite, jts:jte, num_chem ) :: ddvel
91
92 ! turbulent transport
93 real :: pblst(kts:kte-1),ekmfull(kts:kte),zzfull(kts:kte),zz(kts:kte-1)
94 integer :: ii,jj,kk,i,j,k,nv
95 !
96 ! necessary for aerosols (module dependent)
97 !
98 REAL, DIMENSION( its:ite, jts:jte ) :: aer_res
99
100 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
101
102
103 ! ..
104 ! .. Intrinsic Functions ..
105 INTRINSIC max, min
106
107 ! ..
108 ddvel(:,:,:) = 0.
109 IF( config_flags%chem_opt /= CHEM_TRACER ) THEN
110 drydep_select: SELECT CASE(config_flags%drydep_opt)
111 CASE (WESELY)
112 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES WITH WESELY METHOD')
113 call wesely_driver(id,ktau,dtstep, &
114 config_flags, &
115 gmt,julday,t_phy,moist,p8w,t8w, &
116 p_phy,chem,rho_phy,dz8w,ddvel,aer_res, &
117 ivgtyp,tsk,gsw,vegfra,pbl,rmol,ust,znt,xlat,xlong,z,z_at_w,&
118 numgas, &
119 ids,ide, jds,jde, kds,kde, &
120 ims,ime, jms,jme, kms,kme, &
121 its,ite, jts,jte, kts,kte )
122
123 CASE DEFAULT
124
125 END SELECT drydep_select
126 ELSE
127 !Set dry deposition velocity to zero when using the
128 !chemistry tracer mode.
129 END IF
130
131 adrydep_select: SELECT CASE(config_flags%chem_opt)
132 CASE (RADM2SORG,RADM2SORG_KPP)
133 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR AEROSOLS/RADM')
134 call sorgam_depdriver (id,ktau,dtstep, &
135 ust,t_phy,moist,p8w,t8w, &
136 alt,p_phy,chem,rho_phy,dz8w,z,z_at_w, &
137 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
138 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2, &
139 aer_res,ddvel(:,:,numgas+1:num_chem), &
140 num_chem-numgas, &
141 ids,ide, jds,jde, kds,kde, &
142 ims,ime, jms,jme, kms,kme, &
143 its,ite, jts,jte, kts,kte )
144 CASE (RACMSORG,RACMSORG_KPP)
145 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR AEROSOLS/RACM')
146 call sorgam_depdriver (id,ktau,dtstep, &
147 ust,t_phy,moist,p8w,t8w, &
148 alt,p_phy,chem,rho_phy,dz8w,z,z_at_w, &
149 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
150 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2, &
151 aer_res,ddvel(:,:,numgas+1:num_chem), &
152 num_chem-numgas, &
153 ids,ide, jds,jde, kds,kde, &
154 ims,ime, jms,jme, kms,kme, &
155 its,ite, jts,jte, kts,kte )
156 CASE ( CBMZ_MOSAIC_AA, CBMZ_MOSAIC_BB )
157 CALL wrf_debug(15,'DOING DRY DEP VELOCITIES FOR MOSAIC AEROSOLS')
158 call mosaic_drydep_driver( &
159 id, ktau, dtstep, config_flags, &
160 gmt, julday, &
161 t_phy, rho_phy, p_phy, &
162 ust, aer_res, &
163 moist, chem, ddvel, &
164 ids,ide, jds,jde, kds,kde, &
165 ims,ime, jms,jme, kms,kme, &
166 its,ite, jts,jte, kts,kte )
167 CASE DEFAULT
168
169 END SELECT adrydep_select
170 ! This will be called later from subgrd_transport_driver.F !!!!!!!!
171 !
172 !
173 dep_vel_o3=0.
174 do 100 j=jts,jte
175 do 100 i=its,ite
176 pblst=0.
177 !
178 !
179 !-- start with vertical mixing
180 !
181 do k=kts,kte
182 zzfull(k)=z_at_w(i,k,j)-z_at_w(i,kts,j)
183 ekmfull(k)=max(1.e-6,exch_h(i,k,j))
184 enddo
185
186 !
187 ! --- Mix the emissions up several layers
188 ! if e_co > 0., the grid cell should not be over water
189 ! if e_co > 200, the grid cell should be over a large urban region
190 !
191 if (e_co(i,kts,j) .gt. 0) then
192 ekmfull(kts:kts+10) = max(ekmfull(kts:kts+10),1.)
193 endif
194 if (e_co(i,kts,j) .gt. 200) then
195 ekmfull(kts:kte/2) = max(ekmfull(kts:kte/2),2.)
196 endif
197 !
198 !
199 !
200 do k=kts,kte-1
201 zz(k)=z(i,k,j)-z_at_w(i,kts,j)
202 enddo
203 ekmfull(kts)=0.
204 ekmfull(kte)=0.
205 !
206 ! vertical mixing routine (including deposition)
207 ! need to be careful here with that dumm tracer in spot 1
208 ! do not need lho,lho2
209 !
210 dep_vel_o3(i,j)=ddvel(i,j,p_o3)
211 do nv=2,num_chem-0
212 do k=kts,kte-1
213 pblst(k)=max(epsilc,chem(i,k,j,nv))
214 enddo
215 ! if(ktau.ge.20)then
216 ! write(0,*)i,j,nv,ddvel(i,j,nv),e_co(i,kts,j)
217 ! endif
218
219 call vertmx(dtstep,pblst,ekmfull,zzfull,zz,ddvel(i,j,nv),kts,kte-1)
220
221 do k=kts,kte-2
222
223 chem(i,k,j,nv)=max(epsilc,pblst(k))
224 enddo
225 enddo
226 100 continue
227 END SUBROUTINE dry_dep_driver