module_wetscav_driver.F
References to this file elsewhere.
1 !**********************************************************************************
2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
6 !
7 ! MOSAIC module: see module_mosaic_driver.F for information and terms of use
8 !**********************************************************************************
9
10 MODULE module_wetscav_driver
11
12
13 CONTAINS
14
15
16 !===========================================================================
17 !===========================================================================
18 subroutine wetscav_driver (id,ktau,dtstep,ktauc,config_flags, &
19 dtstepc,alt,t_phy,moist,p8w,t8w,p_phy,chem,rho_phy,cldfra, &
20 qlsink,precr,preci,precs,precg, &
21 gas_aqfrac, numgas_aqfrac, &
22 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1, &
23 cvaro2,cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2,&
24 ids,ide, jds,jde, kds,kde, &
25 ims,ime, jms,jme, kms,kme, &
26 its,ite, jts,jte, kts,kte )
27
28 !----------------------------------------------------------------------
29 !
30 ! wet removal by grid-resolved precipitation
31 ! scavenging of cloud-phase aerosols and gases by collection, freezing, ...
32 ! scavenging of interstitial-phase aerosols by impaction
33 ! scavenging of gas-phase gases by mass transfer and reaction
34 !
35 ! This driver calls subroutines for wet scavenging.
36 !
37 ! 1. MADE-SORGAM (Not yet implemented.)
38 ! 2. MOSAIC
39 !
40 !----------------------------------------------------------------------
41
42 USE module_configure
43 USE module_state_description
44 USE module_model_constants
45 USE module_mosaic_wetscav
46
47 IMPLICIT NONE
48
49 !======================================================================
50 ! Grid structure in physics part of WRF
51 !----------------------------------------------------------------------
52 ! The horizontal velocities used in the physics are unstaggered
53 ! relative to temperature/moisture variables. All predicted
54 ! variables are carried at half levels except w, which is at full
55 ! levels. Some arrays with names (*8w) are at w (full) levels.
56 !
57 !----------------------------------------------------------------------
58 ! In WRF, kms (smallest number) is the bottom level and kme (largest
59 ! number) is the top level. In your scheme, if 1 is at the top level,
60 ! then you have to reverse the order in the k direction.
61 !
62 ! kme - half level (no data at this level)
63 ! kme ----- full level
64 ! kme-1 - half level
65 ! kme-1 ----- full level
66 ! .
67 ! .
68 ! .
69 ! kms+2 - half level
70 ! kms+2 ----- full level
71 ! kms+1 - half level
72 ! kms+1 ----- full level
73 ! kms - half level
74 ! kms ----- full level
75 !
76 !======================================================================
77 ! Definitions
78 !-----------
79 !-- alt inverse density
80 !-- t_phy temperature (K)
81 !-- w vertical velocity (m/s)
82 !-- moist moisture array (4D - last index is species) (kg/kg)
83 !-- dz8w dz between full levels (m)
84 !-- p8w pressure at full levels (Pa)
85 !-- p_phy pressure (Pa)
86 ! points (dimensionless)
87 !-- z 3D height with lowest level being the terrain
88 !-- rho_phy density (kg/m^3)
89 !-- qlsink Fractional cloud water sink (/s)
90 !-- precr rain precipitation rate at all levels (kg/m2/s)
91 !-- preci ice precipitation rate at all levels (kg/m2/s)
92 !-- precs snow precipitation rate at all levels (kg/m2/s)
93 !-- precg graupel precipitation rate at all levels (kg/m2/s) &
94 !-- R_d gas constant for dry air ( 287. J/kg/K)
95 !-- R_v gas constant for water vapor (461 J/k/kg)
96 !-- Cp specific heat at constant pressure (1004 J/k/kg)
97 !-- rvovrd R_v divided by R_d (dimensionless)
98 !-- G acceleration due to gravity (m/s^2)
99 !-- ids start index for i in domain
100 !-- ide end index for i in domain
101 !-- jds start index for j in domain
102 !-- jde end index for j in domain
103 !-- kds start index for k in domain
104 !-- kde end index for k in domain
105 !-- ims start index for i in memory
106 !-- ime end index for i in memory
107 !-- jms start index for j in memory
108 !-- jme end index for j in memory
109 !-- kms start index for k in memory
110 !-- kme end index for k in memory
111 !-- its start index for i in tile
112 !-- ite end index for i in tile
113 !-- jts start index for j in tile
114 !-- jte end index for j in tile
115 !-- kts start index for k in tile
116 !-- kte end index for k in tile
117 !-- config_flags%kemit end index for k for emissions arrays
118 !
119 !======================================================================
120
121 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
122
123 INTEGER, INTENT(IN ) :: &
124 ids,ide, jds,jde, kds,kde, &
125 ims,ime, jms,jme, kms,kme, &
126 its,ite, jts,jte, kts,kte, &
127 id, ktau, ktauc, numgas_aqfrac
128
129 REAL, INTENT(IN ) :: dtstep,dtstepc
130 !
131 ! moisture variables
132 !
133 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
134 INTENT(IN ) :: moist
135 !
136 ! all advected chemical species
137 !
138 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
139 INTENT(INOUT ) :: chem
140
141 ! fraction of gas species in cloud water
142 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, numgas_aqfrac ), &
143 INTENT(IN ) :: gas_aqfrac
144
145 !
146 ! following are aerosol arrays that are not advected
147 !
148 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
149 INTENT(INOUT ) :: &
150 h2oaj,h2oai,nu3,ac3,cor3,asulf,ahno3,anh3,cvaro1,cvaro2, &
151 cvalk1,cvole1,cvapi1,cvapi2,cvlim1,cvlim2
152 !
153 ! input from meteorology
154 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
155 INTENT(IN ) :: &
156 alt, &
157 t_phy, &
158 p_phy, &
159 t8w,p8w, &
160 qlsink,precr,preci,precs,precg, &
161 rho_phy,cldfra
162 !
163
164 ! LOCAL VAR
165 integer :: ii,jj,kk
166 REAL, DIMENSION( ims:ime, jms:jme, num_chem ) :: qsrflx ! column change due to scavening
167
168
169 !-----------------------------------------------------------------
170
171 ! These are unneeded, since the default behavior is to do nothing.
172 ! If the default changes, then lines need to be added for CBMZ and
173 ! CBMZ_BB.
174 ! IF (config_flags%chem_opt .eq. 0) return
175 ! IF (config_flags%chem_opt .eq. 1) return
176
177 !
178 ! select which aerosol scheme to take
179 !
180 cps_select: SELECT CASE(config_flags%chem_opt)
181
182 CASE (RADM2SORG)
183 CALL wrf_debug(15,'wetscav_driver calling sorgam_wetscav_driver')
184 do ii=its,ite
185 do kk=kts,kte
186 do jj=jts,jte
187 if(chem(ii,kk,jj,p_nu0).lt.1.e07)then
188 chem(ii,kk,jj,p_nu0)=1.e7
189 endif
190 enddo
191 enddo
192 enddo
193
194 CASE (RACMSORG)
195 CALL wrf_debug(15,'wetscav_driver calling sorgam_wetscav_driver')
196 do ii=its,ite
197 do kk=kts,kte
198 do jj=jts,jte
199 if(chem(ii,kk,jj,p_nu0).lt.1.e07)then
200 chem(ii,kk,jj,p_nu0)=1.e7
201 endif
202 enddo
203 enddo
204 enddo
205
206 CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
207 CALL wrf_debug(15,'wetscav_driver calling mosaic_wetscav_driver')
208 call wetscav_cbmz_mosaic (id,ktau,dtstep,ktauc,config_flags, &
209 dtstepc,alt,t_phy,p8w,t8w,p_phy,chem,rho_phy,cldfra, &
210 qlsink,precr,preci,precs,precg, qsrflx, &
211 gas_aqfrac, numgas_aqfrac, &
212 ids,ide, jds,jde, kds,kde, &
213 ims,ime, jms,jme, kms,kme, &
214 its,ite, jts,jte, kts,kte )
215
216 CASE DEFAULT
217
218 END SELECT cps_select
219
220 end subroutine wetscav_driver
221
222
223 END MODULE module_wetscav_driver
224
225