module_mixactivate_wrappers.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 !----------------------------------------------------------------------
11 ! This module contains interface wrapper routines to couple the aerosol
12 ! modules with mixactivate in the physics directory. Due to compiling
13 ! dependencies, these cannot be placed in module_mixactivate.
14 !----------------------------------------------------------------------
15
16 MODULE module_mixactivate_wrappers
17
18 CONTAINS
19
20 !----------------------------------------------------------------------
21 !----------------------------------------------------------------------
22 subroutine mosaic_mixactivate ( &
23 id, ktau, dtstep, config_flags, idrydep_onoff, &
24 rho_phy, t_phy, w, cldfra, cldfra_old, &
25 ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
26 qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
27 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
28 ids,ide, jds,jde, kds,kde, &
29 ims,ime, jms,jme, kms,kme, &
30 its,ite, jts,jte, kts,kte )
31
32 USE module_configure, only: grid_config_rec_type
33 use module_state_description, only: num_chem
34 use module_data_mosaic_asect
35 use module_mixactivate, only: mixactivate
36
37 ! wrapper to call mixactivate for mosaic description of aerosol
38
39 implicit none
40
41 ! subr arguments
42 integer, intent(in) :: &
43 id, ktau, &
44 ids, ide, jds, jde, kds, kde, &
45 ims, ime, jms, jme, kms, kme, &
46 its, ite, jts, jte, kts, kte, &
47 idrydep_onoff
48
49 real, intent(in) :: dtstep
50
51 real, intent(in), &
52 dimension( ims:ime, kms:kme, jms:jme ) :: &
53 rho_phy, t_phy, w, &
54 z, dz8w, p_at_w, t_at_w, exch_h
55
56 real, intent(inout), &
57 dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
58
59 real, intent(in), &
60 dimension( its:ite, jts:jte, num_chem ) :: ddvel
61
62 real, intent(in), &
63 dimension( ims:ime, kms:kme, jms:jme ) :: &
64 qv, qc, qi
65
66 LOGICAL, intent(in) :: f_qc, f_qi
67
68 real, intent(inout), &
69 dimension( ims:ime, kms:kme, jms:jme ) :: &
70 qndrop3d
71
72 real, intent(inout), &
73 dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
74 chem
75 real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource,&
76 ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
77
78 type(grid_config_rec_type), intent(in) :: config_flags
79 ! local vars
80 real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
81 real sumhygro,sumvol
82 integer i,j,k,l,m,n
83 real hygro( its:ite, kts:kte, jts:jte, maxd_asize, maxd_atype ) ! bulk
84
85
86 ! calculate volume-weighted bulk hygroscopicity for each type and size
87 !!$ hygro(its:ite, :, jts:jte, :, :) = 0. !~wig: testing, should not need this
88 do 100 j=jts,jte
89 do 100 k=kts,kte
90 do 100 i=its,ite
91 do n=1,ntype_aer
92 do m=1,nsize_aer(n)
93 sumhygro=0.
94 sumvol=0.
95 do l=1,ncomp_aer(n)
96 sumhygro = sumhygro+hygro_aer(l,n)* &
97 chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
98 sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
99 end do ! comp
100 hygro(i,k,j,m,n)=sumhygro/sumvol
101 end do ! size
102 end do ! type
103 100 continue
104
105 ! check arguments of mixactivate for consistency between send, receive
106 ! 06-nov-2005 rce - id & ktau added to arg list
107 call mixactivate( msectional, &
108 chem, num_chem, qv, qc, qi, qndrop3d, &
109 t_phy, w, ddvel, idrydep_onoff, &
110 maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
111 ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
112 numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
113 dens_aer, mw_aer, &
114 waterptr_aer, hygro, ai_phase, cw_phase, &
115 ids,ide, jds,jde, kds,kde, &
116 ims,ime, jms,jme, kms,kme, &
117 its,ite, jts,jte, kts,kte, &
118 rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
119 cldfra, cldfra_old, qsrflx, &
120 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
121 id, ktau, dtstep, &
122 f_qc, f_qi )
123
124 end subroutine mosaic_mixactivate
125
126
127 !----------------------------------------------------------------------
128 !----------------------------------------------------------------------
129
130 subroutine mosaic_mixactivate_init( &
131 config_flags, chem, scalar, &
132 ims,ime, jms,jme, kms,kme, &
133 its,ite, jts,jte, kts,kte )
134
135 USE module_configure, only: grid_config_rec_type
136 use module_state_description, only: num_chem, num_scalar, p_qndrop
137 use module_data_mosaic_asect
138
139 implicit none
140
141 ! subr arguments
142 type(grid_config_rec_type), intent(in) :: config_flags
143
144 integer, intent(in) :: &
145 ims, ime, jms, jme, kms, kme, &
146 its, ite, jts, jte, kts, kte
147
148 real, intent(inout), &
149 dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
150 chem
151
152 real, intent(inout), &
153 dimension( ims:ime, kms:kme, jms:jme, 1:num_scalar ) :: &
154 scalar
155
156 integer :: i, j, k, m, n, l
157
158 do j=jts,jte
159 do k=kts,kte
160 do i=its,ite
161 scalar(i,k,j,p_qndrop) = 0.
162 end do
163 end do
164 end do
165
166 if( cw_phase > 0 ) then !sanity check in case using prognostic
167 !drop number without aq. chemistry
168 do n=1,ntype_aer
169 do m=1,nsize_aer(n)
170 chem(its:ite,kts:kte,jts:jte,numptr_aer(m,n,cw_phase)) = 0.
171 do l=1,ncomp_aer(n)
172 chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,cw_phase)) = 0.
173 end do ! comp
174 end do ! size
175 end do ! type
176 end if
177
178 end subroutine mosaic_mixactivate_init
179
180
181 !----------------------------------------------------------------------
182 !----------------------------------------------------------------------
183
184
185 subroutine sorgam_mixactivate ( &
186 id, ktau, dtstep, config_flags, idrydep_onoff, &
187 rho_phy, t_phy, w, cldfra, cldfra_old, &
188 ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
189 qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
190 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
191 ids,ide, jds,jde, kds,kde, &
192 ims,ime, jms,jme, kms,kme, &
193 its,ite, jts,jte, kts,kte )
194
195 USE module_configure, only: grid_config_rec_type
196 use module_state_description, only: num_chem
197 use module_data_sorgam
198 use module_mixactivate, only: mixactivate
199
200 ! wrapper to call mixactivate for sorgam description of aerosol
201
202 implicit none
203
204 ! subr arguments
205 integer, intent(in) :: &
206 id, ktau, &
207 ids, ide, jds, jde, kds, kde, &
208 ims, ime, jms, jme, kms, kme, &
209 its, ite, jts, jte, kts, kte, &
210 idrydep_onoff
211
212 real, intent(in) :: dtstep
213
214 real, intent(in), &
215 dimension( ims:ime, kms:kme, jms:jme ) :: &
216 rho_phy, t_phy, w, &
217 z, dz8w, p_at_w, t_at_w, exch_h
218
219 real, intent(inout), &
220 dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
221
222 real, intent(in), &
223 dimension( its:ite, jts:jte, num_chem ) :: ddvel
224
225 real, intent(in), &
226 dimension( ims:ime, kms:kme, jms:jme ) :: &
227 qv, qc, qi
228
229 LOGICAL, intent(in) :: f_qc, f_qi
230
231 real, intent(inout), &
232 dimension( ims:ime, kms:kme, jms:jme ) :: &
233 qndrop3d
234
235 real, intent(inout), &
236 dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
237 chem
238 real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
239 ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
240
241 type(grid_config_rec_type), intent(in) :: config_flags
242
243 ! local vars
244 real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
245 real sumhygro,sumvol
246 integer i,j,k,l,m,n
247 real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype )
248
249 ! calculate volume-weighted bulk hygroscopicity for each type and size
250
251 do 100 j=jts,jte
252 do 100 k=kts,kte
253 do 100 i=its,ite
254 do n=1,ntype_aer
255 do m=1,nsize_aer(n)
256 sumhygro=0
257 sumvol=0
258 do l=1,ncomp_aer(n)
259 sumhygro = sumhygro+hygro_aer(l,n)* &
260 chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
261 sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
262 end do ! comp
263 hygro(i,k,j,m,n)=sumhygro/sumvol
264 end do ! size
265 end do ! type
266 100 continue
267
268
269 ! check arguments of mixactivate for consistency between send, receive
270 ! 06-nov-2005 rce - id & ktau added to arg list
271 call mixactivate( msectional, &
272 chem, num_chem, qv, qc, qi, qndrop3d, &
273 t_phy, w, ddvel, idrydep_onoff, &
274 maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
275 ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
276 numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
277 dens_aer, mw_aer, &
278 waterptr_aer, hygro, ai_phase, cw_phase, &
279 ids,ide, jds,jde, kds,kde, &
280 ims,ime, jms,jme, kms,kme, &
281 its,ite, jts,jte, kts,kte, &
282 rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
283 cldfra, cldfra_old, qsrflx, &
284 ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
285 id, ktau, dtstep, &
286 f_qc, f_qi )
287
288 end subroutine sorgam_mixactivate
289
290
291 END MODULE module_mixactivate_wrappers