File: /nfs/home/0/users/jenkins/mfix.git/model/chem/stiff_chem_rrates.f
1
2
3
4
5
6
7
8
9
10
11
12 SUBROUTINE STIFF_CHEM_RRATES(lNEQ, lTime, Y, YDOT)
13
14
15
16 use stiff_chem_maps, only: mapODEtoMFIX
17
18
19
20
21 use param, only: DIMENSION_M
22
23 use param, only: DIMENSION_N_g
24
25 use param, only: DIMENSION_N_s
26
27 use param1, only: ZERO
28
29
30
31
32 use physprop, only: MMAX
33
34 use physprop, only: NMAX
35
36
37
38
39 use fldvar, only: T_g
40
41 use fldvar, only: X_g
42
43 use fldvar, only: ROP_g
44
45 use physprop, only: C_pg
46
47
48
49
50 use fldvar, only: T_s
51
52 use fldvar, only: X_s
53
54 use fldvar, only: ROP_s
55
56 use physprop, only: C_ps
57
58
59
60 use rxns, only: REACTION
61 use rxns, only: NO_OF_RXNS
62
63 use run, only: SPECIES_EQ
64 use run, only: UNITS
65
66 use stiff_chem, only: ODE_DIMN_all
67 use stiff_chem, only: NEQ_DIMN
68
69 implicit none
70
71
72
73
74
75 INTEGER, intent(in) :: lNEQ(NEQ_DIMN)
76
77 DOUBLE PRECISION, intent(in) :: lTime
78
79 DOUBLE PRECISION, dimension(ODE_DIMN_all), intent(in) :: Y
80
81 DOUBLE PRECISION, dimension(ODE_DIMN_all), intent(out) :: YDOT
82
83
84
85 INTEGER :: IJK
86 INTEGER :: H
87 INTEGER :: L, M
88 INTEGER :: N
89 INTEGER :: lN
90 INTEGER :: mXfr
91 INTEGER :: Node
92
93
94 DOUBLE PRECISION :: RATES(NO_OF_RXNS)
95
96 DOUBLE PRECISION :: lRate
97
98
99 DOUBLE PRECISION :: lRg(DIMENSION_N_g)
100
101
102 DOUBLE PRECISION :: rRg(DIMENSION_N_g)
103
104 DOUBLE PRECISION :: rHORg
105
106 DOUBLE PRECISION :: lHORg
107
108
109 DOUBLE PRECISION :: lRs(DIMENSION_M, DIMENSION_N_s)
110
111
112 DOUBLE PRECISION :: rRs(DIMENSION_M, DIMENSION_N_s)
113
114 DOUBLE PRECISION :: rHORs(DIMENSION_M)
115
116 DOUBLE PRECISION :: lHORs(DIMENSION_M)
117
118 DOUBLE PRECISION :: RxH(0:DIMENSION_M, 0:DIMENSION_M)
119
120
121 INTEGER :: iErr
122
123
124
125 DOUBLE PRECISION :: sumlRg
126
127 DOUBLE PRECISION :: sumlRs(DIMENSION_M)
128
129
130 DOUBLE PRECISION, parameter :: speciesLimiter = 1.0d-7
131
132
133 LOGICAL, external :: COMPARE
134 DOUBLE PRECISION, external :: CALC_H
135
136
137 external USR_RATES
138
139
140 = lNEQ(2)
141 RATES = ZERO
142 YDOT = ZERO
143
144 lRg = ZERO; lHORg = ZERO
145 lRs = ZERO; lHORs = ZERO
146
147
148 CALL mapODEtoMFIX(NEQ_DIMN, lNEQ, ODE_DIMN_all, Y)
149
150
151 CALL USR_RATES(IJK, RATES)
152
153
154 RXN_LP: DO H = 1, NO_OF_RXNS
155
156
157 IF(Reaction(H)%nSpecies == 0) CYCLE RXN_LP
158
159
160 = ZERO; rHORg = ZERO
161 rRs = ZERO; rHORs = ZERO
162 RxH = ZERO
163
164
165
166 DO lN = 1, Reaction(H)%nSpecies
167
168 = Reaction(H)%Species(lN)%pMap
169
170 = Reaction(H)%Species(lN)%sMap
171
172
173
174 = Reaction(H)%Species(lN)%mXfr
175 lRate = RATES(H) * Reaction(H)%Species(lN)%MWxStoich
176
177 IF(M == 0) THEN
178
179 IF(lRate < ZERO) THEN
180
181 IF(X_g(IJK,N) > speciesLimiter) THEN
182 rRg(N) = rRg(N) + lRate
183
184 IF(M /= mXfr) RxH(M,mXfr) = RxH(M,mXfr) + &
185 lRate * CALC_H(T_G(IJK),0,N)
186 ELSE
187
188 CYCLE RXN_LP
189 ENDIF
190 ELSE
191
192 (N) = rRg(N) + lRate
193
194 IF(M /= mXfr) RxH(M,mXfr) = RxH(M,mXfr) + &
195 lRate * CALC_H(T_s(IJK,mXfr),0,N)
196 ENDIF
197
198 ELSE
199
200 IF(lRate < ZERO) THEN
201 IF(X_s(IJK,M,N) > speciesLimiter) THEN
202 rRs(M,N) = rRs(M,N) + lRate
203
204
205 IF(M /= mXfr) THEN
206 IF(M < mXfr) THEN
207 RxH(M,mXfr) = RxH(M,mXfr) + &
208 lRate * CALC_H(T_s(IJK,M),M,N) * &
209 Reaction(H)%Species(lN)%xXfr
210 ELSE
211 RxH(mXfr,M) = RxH(mXfr,M) - &
212 lRate * CALC_H(T_s(IJK,M),M,N) * &
213 Reaction(H)%Species(lN)%xXfr
214 ENDIF
215 ENDIF
216 ELSE
217
218 CYCLE RXN_LP
219 ENDIF
220 ELSE
221
222 (M,N) = rRs(M,N) + lRate
223 ENDIF
224 ENDIF
225 ENDDO
226
227
228
229
230 = lRg + rRg
231 lRs = lRs + rRs
232
233
234
235
236 IF(Reaction(H)%Calc_DH) THEN
237
238 DO lN = 1, Reaction(H)%nSpecies
239
240 = Reaction(H)%Species(lN)%pMap
241
242 = Reaction(H)%Species(lN)%sMap
243
244 = RATES(H) * Reaction(H)%Species(lN)%MWxStoich
245
246 IF(M == 0) THEN
247 rHORg = rHORg + lRate * CALC_H(T_g(IJK),0,N)
248
249 ELSE
250 rHORs(M) = rHORs(M) + lRate * CALC_H(T_s(IJK,M),M,N)
251 ENDIF
252 ENDDO
253
254
255 DO M=1, MMAX
256 DO L=0, M-1
257 RxH(M,L) = - RxH(L,M)
258 ENDDO
259 ENDDO
260
261
262 DO L=0, MMAX
263 DO M = 0, MMAX
264 IF(L == M) CYCLE
265 IF(L == 0) THEN
266 rHORg = rHORg - RxH(L,M)
267 ELSE
268 rHORs(L) = rHORs(L) - RxH(L,M)
269 ENDIF
270 ENDDO
271 ENDDO
272
273
274
275 IF(UNITS == 'SI') THEN
276 lHORg = lHORg + 4.183925d3*rHORg
277 DO M=1,MMAX
278 lHORs(M) = lHORs(M) + 4.183925d3*rHORs(M)
279 ENDDO
280 ELSE
281 lHORg = lHORg + rHORg
282 DO M=1,MMAX
283 lHORs(M) = lHORs(M) + rHORs(M)
284 ENDDO
285 ENDIF
286 ELSE
287
288 = lHORg + Reaction(H)%HoR(0) * RATES(H)
289 DO M=1, MMAX
290 lHORs(M) = lHORs(M) + Reaction(H)%HoR(M) * RATES(H)
291 ENDDO
292 ENDIF
293
294 ENDDO RXN_LP
295
296
297
298
299
300
301
302
303 = sum(lRg)
304
305
306 = 0.0d0
307 DO M=1, MMAX
308 IF(lNEQ(2+M) == 1) sumlRs(M) = sum(lRs(M,:))
309 ENDDO
310
311
312
313
314
315 = 1
316
317
318 (Node) = sumlRg
319 Node = Node + 1
320
321
322 (Node) = -lHORg/(ROP_g(IJK)*C_pg(IJK))
323 Node = Node + 1
324
325
326 DO N=1,NMAX(0)
327 YDOT(Node) = (lRg(N) - X_g(IJK,N)*sumlRg)/(ROP_g(IJK))
328 Node = Node + 1
329 ENDDO
330
331
332
333 DO M = 1, MMAX
334 IF(ROP_s(IJK,M) > 1.0d-8) THEN
335 YDOT(Node) = -lHORs(M)/(ROP_s(IJK,M)*C_ps(IJK,M))
336 ELSE
337 YDOT(Node) = 0.0d0
338 ENDIF
339 Node = Node + 1
340 ENDDO
341
342
343 DO M = 1, MMAX
344 IF(lNEQ(2+M) == 1) THEN
345
346 (Node) = sumlRs(M)
347 Node = Node + 1
348
349 DO N=1, NMAX(M)
350 YDOT(Node) = (lRs(M,N) - X_s(IJK,M,N)*sumlRs(M)) / &
351 ROP_s(IJK,M)
352 Node = Node + 1
353 ENDDO
354 ENDIF
355 ENDDO
356
357 RETURN
358 END SUBROUTINE STIFF_CHEM_RRATES
359