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            ims,ime, jms,jme, kms,kme,                        &
29            its,ite, jts,jte, kts,kte                         )
30 
31     USE module_configure, only: grid_config_rec_type
32 	use module_state_description, only:  num_chem
33 	use module_data_mosaic_asect
34 	use module_mixactivate, only: mixactivate
35 
36 ! wrapper to call mixactivate for mosaic description of aerosol
37 
38 	implicit none
39 
40 !   subr arguments
41 	integer, intent(in) ::               &
42          id, ktau,                       &
43          ims, ime, jms, jme, kms, kme,   &
44          its, ite, jts, jte, kts, kte,   &
45          idrydep_onoff
46 
47 	real, intent(in) :: dtstep
48 
49 	real, intent(in),   &
50 		dimension( ims:ime, kms:kme, jms:jme ) :: &
51 		rho_phy, t_phy, w,   &
52 		z, dz8w, p_at_w, t_at_w, exch_h
53 
54 	real, intent(inout),   &
55 		dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
56 
57 	real, intent(in),   &
58 		dimension( its:ite, jts:jte, num_chem ) :: ddvel
59 
60 	real, intent(in),   &
61 		dimension( ims:ime, kms:kme, jms:jme ) :: &
62 		qv, qc, qi
63 
64     LOGICAL, intent(in) :: f_qc, f_qi
65 
66 	real, intent(inout),   &
67 		dimension( ims:ime, kms:kme, jms:jme ) :: &
68 		qndrop3d
69 
70 	real, intent(inout),   &
71 		dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
72 		chem
73       real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource,&
74 	     ccn1,ccn2,ccn3,ccn4,ccn5,ccn6  ! number conc of aerosols activated at supersat
75 
76 	type(grid_config_rec_type), intent(in) :: config_flags
77 ! local vars
78 	real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
79 	real sumhygro,sumvol
80 	integer i,j,k,l,m,n
81 	real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype ) ! bulk
82 
83 
84 ! calculate volume-weighted bulk hygroscopicity for each type and size
85 
86       do 100 j=jts,jte
87       do 100 k=kts,kte
88       do 100 i=its,ite
89        do n=1,ntype_aer
90        do m=1,nsize_aer(n)
91 	       sumhygro=0
92 	       sumvol=0
93 	       do l=1,ncomp_aer(n)
94 	          sumhygro = sumhygro+hygro_aer(l,n)*   &
95                    chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
96 	          sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
97 	       end do ! comp
98                hygro(i,k,j,m,n)=sumhygro/sumvol
99 	end do ! size
100 	end do ! type
101   100 continue
102 
103 ! check arguments of mixactivate for consistency between send, receive
104 ! 06-nov-2005 rce - id & ktau added to arg list
105       call mixactivate(  msectional, &
106            chem, num_chem, qv, qc, qi, qndrop3d,   &
107            t_phy, w, ddvel, idrydep_onoff,  &
108            maxd_acomp, maxd_asize, maxd_atype, maxd_aphase,   &
109            ncomp_aer, nsize_aer, ntype_aer, nphase_aer,  &
110            numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect,  &
111            dens_aer, mw_aer,           &
112            waterptr_aer, hygro,  ai_phase, cw_phase,                &
113            ims,ime, jms,jme, kms,kme,                            &
114            its,ite, jts,jte, kts,kte,                            &
115            rho_phy, z, dz8w, p_at_w, t_at_w, exch_h,      &
116            cldfra, cldfra_old, qsrflx, &
117 	       ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource,       &
118 	       id, ktau, dtstep, &
119            f_qc, f_qi               )
120 
121       end subroutine mosaic_mixactivate
122 
123 
124 !----------------------------------------------------------------------
125 !----------------------------------------------------------------------
126       subroutine sorgam_mixactivate (                        &
127            id, ktau, dtstep, config_flags, idrydep_onoff,    &
128            rho_phy, t_phy, w, cldfra, cldfra_old,            &
129            ddvel, z, dz8w, p_at_w, t_at_w, exch_h,           &
130            qv, qc, qi, qndrop3d, f_qc, f_qi, chem,           &
131 	       ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource,      &
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
137 	use module_data_sorgam
138 	use module_mixactivate, only: mixactivate
139 
140 ! wrapper to call mixactivate for sorgam description of aerosol
141 
142 	implicit none
143 
144 !   subr arguments
145 	integer, intent(in) ::                  &
146 		id, ktau,                       &
147 		ims, ime, jms, jme, kms, kme,   &
148 		its, ite, jts, jte, kts, kte,   &
149                 idrydep_onoff
150 
151 	real, intent(in) :: dtstep
152 
153 	real, intent(in),   &
154 		dimension( ims:ime, kms:kme, jms:jme ) :: &
155 		rho_phy, t_phy, w,   &
156 		z, dz8w, p_at_w, t_at_w, exch_h
157 
158 	real, intent(inout),   &
159 		dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
160 
161 	real, intent(in),   &
162 		dimension( its:ite, jts:jte, num_chem ) :: ddvel
163 
164 	real, intent(in),   &
165 		dimension( ims:ime, kms:kme, jms:jme ) :: &
166 		qv, qc, qi
167 
168     LOGICAL, intent(in) :: f_qc, f_qi
169 
170 	real, intent(inout),   &
171 		dimension( ims:ime, kms:kme, jms:jme  ) :: &
172 		qndrop3d
173 
174 	real, intent(inout),   &
175 		dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
176 		chem
177       real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
178 	     ccn1,ccn2,ccn3,ccn4,ccn5,ccn6  ! number conc of aerosols activated at supersat
179 
180 	type(grid_config_rec_type), intent(in) :: config_flags
181 
182 ! local vars
183 	real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
184 	real sumhygro,sumvol
185 	integer i,j,k,l,m,n
186 	real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype )
187 
188 ! calculate volume-weighted bulk hygroscopicity for each type and size
189 
190       do 100 j=jts,jte
191       do 100 k=kts,kte
192       do 100 i=its,ite
193        do n=1,ntype_aer
194        do m=1,nsize_aer(n)
195 	       sumhygro=0
196 	       sumvol=0
197 	       do l=1,ncomp_aer(n)
198 	          sumhygro = sumhygro+hygro_aer(l,n)*   &
199                    chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
200 	          sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
201 	       end do ! comp
202                hygro(i,k,j,m,n)=sumhygro/sumvol
203 	end do ! size
204 	end do ! type
205   100 continue
206 
207 
208 ! check arguments of mixactivate for consistency between send, receive
209 ! 06-nov-2005 rce - id & ktau added to arg list
210       call mixactivate(  msectional, &
211            chem, num_chem, qv, qc, qi, qndrop3d,   &
212            t_phy, w, ddvel, idrydep_onoff,  &
213            maxd_acomp, maxd_asize, maxd_atype, maxd_aphase,   &
214            ncomp_aer, nsize_aer, ntype_aer, nphase_aer,  &
215            numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect,  &
216            dens_aer, mw_aer,           &
217            waterptr_aer, hygro,  ai_phase, cw_phase,                 &
218            ims,ime, jms,jme, kms,kme,                            &
219            its,ite, jts,jte, kts,kte,                            &
220            rho_phy, z, dz8w, p_at_w, t_at_w, exch_h,      &
221            cldfra, cldfra_old, qsrflx,                      &
222 	       ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource,       &
223 	       id, ktau, dtstep, &
224            f_qc, f_qi               )
225 
226       end subroutine sorgam_mixactivate
227 
228 
229 END MODULE module_mixactivate_wrappers