-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathaeroset.f.wo.aq.wo.aero
202 lines (200 loc) · 5.75 KB
/
aeroset.f.wo.aq.wo.aero
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
subroutine aeroset(nsec_c,dsec_i,ierr)
c
c-----PMCAMx v3.01 020531
c
c set-up routine for AERO routines in CAMx
c
c Called by:
c READCHM
c
include 'camx.prm'
include 'chmstry.com'
include 'filunit.com'
include 'section.inc'
include 'camx_aero.inc'
include 'camx.com'
include 'grid.com'
include 'section_aq.inc'
include 'dbg.inc'
c
real*8 dsec_i(nsecp1),dsecf_i(nsecp1)
c
c-----Entry point
c
ierr=0
c
c--- Check nsec_c against nsec parameters used in AERO modules
c
if ( nsec .ne. nsect ) then
write(iout,*) ' ERROR: nsec and nsect must be equal!'
write(iout,*) ' NSEC =',nsec, '; NSECT =',nsect
ierr = 1
return
endif
if ( nsec_c .ne. nsec ) then
write(iout,*) ' ERROR: nsec_c and nsec must be equal!'
write(iout,*) ' NSEC_C =',nsec_c, '; NSEC =',nsec
ierr = 1
return
endif
c
c The following specifies which AERO Modules to use
c
chaero='EQUI'
c chaero='MADM'
c chaero='HYBR'
c chaq = 'RADM'
c chaq = 'VSRM' ! DO NOT USE THIS !!!
chaq = 'OVSR' ! USE THIS FOR CMU'S VSRM
lsoap = .true.
c laq = .true.
laq = .false.
c laero = .true.
laero = .false.
ldbg_aero = .false.
lgas = .true.
c
c set cwmin & tamin
c
aqcwmin = cwmin
aqtamin = tamin
c
c-- reset dtaero to hit output interval exactly, if necessary...
c
dtio = amin1(60.,dtinp,dtems,dtout) ! [min]
nsteps = INT( 0.999*dtio/dt_aero ) + 1
dtaero = dtio/nsteps
idate = begdate
if ( idate .ge. 99999) then
call juldate(idate)
endif
do n=1,ngrid
date_aer(n) = idate
grd_time(n) = begtim
call uptime(grd_time(n),date_aer(n),60.*dtaero)
aero_dt(n) = 0.0
enddo
write(*,*) 'grd_time,date_aero: ',grd_time(1),date_aer(1)
lfrst = .true.
if (ldbg_aero) then
write(iout,*) ' CHAERO :',chaero
write(iout,*) ' laq,laero,lsoap :',laq,laero,lsoap
write(*,*) ' CHAERO :',chaero
write(*,*) ' laq,laero,lsoap :',laq,laero,lsoap
endif
c
c CALCULATE THE INITIAL DIAMETERS
c
c
c check user supplied section cutpoints -- monotonically increasing
c
do i=2,nsecp1
if ( dsec_i(i) .le. dsec_i(i-1) ) then
write(iout,'(//,a)') 'ERROR in AEROSET:'
write(iout,'(1X,a)')
&'Invalid section cut-points ... must be monotonically increasing!'
write(iout,'(1X,a,/)') 'Input cut-points are :'
do n=1,nsecp1
write(iout,'(4X,i2,1X,D9.3)') n,dsec_i(n)
enddo
call camxerr()
endif
enddo
c
c For the MOVING sectional approach dsec is the SECTIONAL DIAMETER
dmin=dsec_i(1)
dmax=dsec_i(nsecp1)
cbk do i=1,nsecp1
cbk dsec_c(i)=dsec_i(i)
cbk enddo
cbk dfmin=dmin
cbk dfmax=dmax
do i=1,nsecp1
dsecf_c(i)=dsec_i(i)
enddo
write(idiag,*) ' '
write(idiag,*) 'Particle section cut-points:'
do i=1,nsecp1
write(idiag,'(1x,i2,1x,d9.3)') i,dsecf_c(i)
enddo
write(idiag,*) ' '
c set moving diameters to logarithmic mean of fixed section diameters (tmg,01/25/02)
do i=1,nsec
dsec_c(i)=sqrt(dsecf_c(i)*dsecf_c(i+1))
enddo
c
kso2_c = kso2
kh2o2_c = kh2o2
kform_c = kform
khono_c = khono
ko3_c = ko3
koh_c = koh
kho2_c = kho2
kno3_c = kno3
kno_c = kno
kno2_c = kno2
kpan_c = kpan
kcg1_c = kcg1
kcg2_c = kcg2
kcg3_c = kcg3
kcg4_c = kcg4
khno3_c = khno3
knh3_c = knh3
kh2so4_c = ksulf
khcl_c = khcl
ksoa1_c = ksoa1_1
ksoa2_c = ksoa2_1
ksoa3_c = ksoa3_1
ksoa4_c = ksoa4_1
kcrst_c = kcrust_1
kpoc_c = kpoc_1
kpec_c = kpec_1
kph2o_c = kph2o_1
kpcl_c = kpcl_1
kna_c = kna_1
kpnh4_c = kpnh4_1
kpno3_c = kpno3_1
kpso4_c = kpso4_1
knxoy_c = knxoy ! RADM
c
c set wtfacs for interface between aerosol modules
c
cbk do l=1,mxspec
cbk wtfac_ae(l)=1.0
cbk wtfac_aq(l)=1.0
cbk enddo
c
cbk do k=1,nsec
cbk wtfac_ae(ksoa1_c+(k-1))=wtmol(ksoa1_c+(k-1))/150.
cbk wtfac_ae(ksoa2_c+(k-1))=wtmol(ksoa2_c+(k-1))/150.
cbk wtfac_ae(ksoa3_c+(k-1))=wtmol(ksoa3_c+(k-1))/150.
cbk wtfac_ae(ksoa4_c+(k-1))=wtmol(ksoa4_c+(k-1))/180.
cbk wtfac_ae(kpoc_c+(k-1)) =wtmol(kpoc_c+(k-1))/100.
cbk wtfac_ae(kpec_c+(k-1)) =wtmol(kpec_c+(k-1))/100.
cbk wtfac_ae(kcrst_c+(k-1))=wtmol(kcrst_c+(k-1))/100.
cbk wtfac_ae(kph2o_c+(k-1))=wtmol(kph2o_c+(k-1))/18.
cbk wtfac_ae(kpcl_c+(k-1)) =wtmol(kpcl_c+(k-1))/36.5
cbk wtfac_ae(kna_c+(k-1)) =wtmol(kna_c+(k-1))/23.
cbk wtfac_ae(kpnh4_c+(k-1))=wtmol(kpnh4_c+(k-1))/17.
cbk wtfac_ae(kpno3_c+(k-1))=wtmol(kpno3_c+(k-1))/63.
cbk wtfac_ae(kpso4_c+(k-1))=wtmol(kpso4_c+(k-1))/98.
c
cbk wtfac_aq(ksoa1_c+(k-1))=wtmol(ksoa1_c+(k-1))/150.
cbk wtfac_aq(ksoa2_c+(k-1))=wtmol(ksoa2_c+(k-1))/150.
cbk wtfac_aq(ksoa3_c+(k-1))=wtmol(ksoa3_c+(k-1))/150.
cbk wtfac_aq(ksoa4_c+(k-1))=wtmol(ksoa4_c+(k-1))/180.
cbk wtfac_aq(kpoc_c+(k-1)) =wtmol(kpoc_c+(k-1))/100.
cbk wtfac_aq(kpec_c+(k-1)) =wtmol(kpec_c+(k-1))/100.
cbk wtfac_aq(kcrst_c+(k-1))=wtmol(kcrst_c+(k-1))/100.
cbk wtfac_aq(kph2o_c+(k-1))=wtmol(kph2o_c+(k-1))/18.
cbk wtfac_aq(kpcl_c+(k-1)) =wtmol(kpcl_c+(k-1))/35.5
cbk wtfac_aq(kna_c+(k-1)) =wtmol(kna_c+(k-1))/23.
cbk wtfac_aq(kpnh4_c+(k-1))=wtmol(kpnh4_c+(k-1))/18.
cbk wtfac_aq(kpno3_c+(k-1))=wtmol(kpno3_c+(k-1))/62.
cbk wtfac_aq(kpso4_c+(k-1))=wtmol(kpso4_c+(k-1))/96.
cbk enddo
c
c ----- End -----
c
return
end