File: /nfs/home/0/users/jenkins/mfix.git/model/des/des_rrates0.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: RRATES0(IER)                                           C
4     !  Purpose: Calculate reaction rates for various reactions in cell ijk C
5     !           using information from the data file                       C
6     !                                                                      C
7     !  Author: M. Syamlal                                 Date: 3-10-98    C
8     !  Reviewer:                                          Date:            C
9     !                                                                      C
10     !  Revision Number: 1                                                  C
11     !  Purpose:Replaced routines with new proceedures for automated        C
12     !          reaction rate calculations.                                 C
13     !  Author: J. Musser                                  Date: 10-Oct-12  C
14     !  Reviewer:                                          Date: dd-mmm-yy  C
15     !                                                                      C
16     !  Literature/Document References:                                     C
17     !                                                                      C
18     !  Variables referenced: MMAX, IJK, T_g, T_s1, D_p, X_g, X_s, EP_g,    C
19     !            P_g, HOR_g, HOR_s                                         C
20     !                                                                      C
21     !                                                                      C
22     !  Variables modified: M, N, R_gp, R_sp, RoX_gc, RoX_sc, SUM_R_g,      C
23     !                      SUM_R_s                                         C
24     !                                                                      C
25     !  Local variables:                                                    C
26     !                                                                      C
27     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
28           SUBROUTINE DES_RRATES0(NP, pM, IJK, INTERP_IJK, INTERP_WEIGHTS, &
29              FOCUS)
30     
31           USE compar
32           USE constant
33           USE des_rxns
34           USE des_thermo
35           USE discretelement
36           USE energy
37           USE fldvar
38           USE funits
39           USE geometry
40           USE indices
41           USE parallel
42           USE param
43           USE param1
44           USE physprop
45           USE run
46           USE rxns
47           USE sendrecv
48           USE usr
49           Use parse
50           use functions
51           use toleranc, only: ZERO_X_gs, COMPARE
52     
53           IMPLICIT NONE
54     
55     ! Passed variables
56     !---------------------------------------------------------------------//
57           INTEGER, INTENT(IN) :: NP   ! particle index
58           INTEGER, INTENT(IN) :: pM   ! Global Solids Phase index
59           INTEGER, INTENT(IN) :: IJK  ! fluid cell index
60     ! Variables needed for calculating new interpolation quantities for
61     ! species and energy equations
62           INTEGER, INTENT(IN) :: INTERP_IJK(2**3)
63           DOUBLE PRECISION, INTENT(IN) :: INTERP_WEIGHTS(2**3)
64     ! Identifies that the indicated particle is of interest for debugging
65           LOGICAL, INTENT(IN) :: FOCUS
66     
67     ! Local variables
68     !---------------------------------------------------------------------//
69           INTEGER :: H    ! Reaction loop counter
70           INTEGER :: M    ! Global Phase index loop counter
71           INTEGER :: N    ! Global species index
72           INTEGER :: lN   ! Local reaction speices index/loop counter
73           INTEGER :: LM   !
74     
75           INTEGER :: mXfr ! Global phase index for mass transfer
76     
77     ! User-defined reaction rates returned from USR_RATES
78           DOUBLE PRECISION :: DES_RATES(NO_OF_DES_RXNS)
79     
80           DOUBLE PRECISION :: lRate
81           DOUBLE PRECISION :: lTp
82           DOUBLE PRECISION :: lHoRs
83     
84           DOUBLE PRECISION :: RxH
85     
86     ! Local gas phase values.
87           DOUBLE PRECISION :: lRgp(NMAX(0)) ! Rate of species production
88           DOUBLE PRECISION :: lRgc(NMAX(0)) ! Rate of species consumption
89           DOUBLE PRECISION :: lHoRg, llHoRg ! Heat of reaction
90           DOUBLE PRECISION :: SUMlRg
91     
92     ! Interphase mass transfer
93           DOUBLE PRECISION :: lRPhase(DIMENSION_LM+DIMENSION_M-1)
94     
95     ! Reaction limiters. If a species mass fraction is less than this
96     ! value, then the reaction is suppressed.
97           DOUBLE PRECISION :: speciesLimiter
98     
99     ! External functions
100     !---------------------------------------------------------------------//
101     ! Enthalpy calculations (cal/gram)
102           DOUBLE PRECISION, EXTERNAL :: CALC_H
103     
104     ! Alias particle temperature.
105           lTp = DES_T_s_NEW(NP)
106     ! Initialize storage arrays
107           DES_RATES(:) = ZERO
108           lRgp(:) = ZERO
109           lRgc(:) = ZERO
110           lHoRg = ZERO
111     
112     ! Set the species limiter:
113           speciesLimiter = ZERO_X_gs
114     
115     ! Calculate user defined reaction rates.
116           CALL USR_RATES_DES(NP, pM, IJK, DES_RATES)
117     
118     ! Loop over reactions.
119           RXN_LP: DO H = 1, NO_OF_DES_RXNS
120     
121     ! Skip empty reactions
122              IF(DES_Reaction(H)%nSpecies == 0) CYCLE RXN_LP
123              IF(COMPARE(DES_RATES(H),ZERO)) CYCLE RXN_LP
124     
125     ! Initialize local loop arrays
126              llHoRg = ZERO
127              lHoRs = ZERO
128              RxH = ZERO
129     
130     ! Calculate the rate of formation/consumption for each species.
131     !---------------------------------------------------------------------//
132              DO lN = 1, DES_Reaction(H)%nSpecies
133     ! Global phase index.
134                 M = DES_Reaction(H)%Species(lN)%pMap
135     ! Global species index.
136                 N = DES_Reaction(H)%Species(lN)%sMap
137     ! Index for interphase mass transfer. For a gas/solid reaction, the
138     ! index is stored with the gas phase.
139                 mXfr = DES_Reaction(H)%Species(lN)%mXfr
140                 lRate = DES_RATES(H) * DES_Reaction(H)%Species(lN)%MWxStoich
141     ! Gas Phase:
142                 IF(M == 0) THEN
143     ! Consumption of gas phase species.
144                    IF(lRate < ZERO) THEN
145                       IF(X_g(IJK,N) > speciesLimiter) THEN
146                          lRgc(N) = lRgc(N) - lRate
147     ! Enthalpy transfer associated with mass transfer. (gas/solid)
148                          IF(M /= mXfr) RxH = RxH +                         &
149                             lRate*CALC_H(T_g(IJK),0,N)
150                       ELSE
151     ! There is an insignificant amount of reactant. Skip this reaction.
152                          DES_RATES(H) = ZERO
153                          CYCLE RXN_LP
154                       ENDIF
155                    ELSE
156     ! Formation of gas phase species.
157                       lRgp(N) = lRgp(N) + lRate
158     ! Enthalpy transfer associated with mass transfer. (gas/solid)
159                       IF(M /= mXfr) RxH = RxH + lRate*CALC_H(lTp,0,N)
160                    ENDIF
161     ! Discrete Solids Phase:
162                 ELSE
163     ! Consumption of solids phase species.
164                    IF(lRate < ZERO) THEN
165                       DES_R_sc(NP,N) = DES_R_sc(NP,N) - lRate
166                    ELSE
167     ! Formation of solids phase species.
168                       DES_R_sp(NP,N) = DES_R_sp(NP,N) + lRate
169                    ENDIF
170                 ENDIF
171              ENDDO ! Loop of species
172     
173     
174     ! Calculate and store the heat of reaction.
175     !---------------------------------------------------------------------//
176              IF(ENERGY_EQ) THEN
177     ! Automated heat of reaction calculations
178                 IF(DES_Reaction(H)%Calc_DH) THEN
179     ! Loop over reaction species.
180                    DO lN = 1, DES_Reaction(H)%nSpecies
181     ! Global phase index.
182                       M = DES_Reaction(H)%Species(lN)%pMap
183     ! Global species index.
184                       N = DES_Reaction(H)%Species(lN)%sMap
185     ! Rate of formation/consumption for speices N
186                       lRate = DES_RATES(H) * &
187                          DES_Reaction(H)%Species(lN)%MWxStoich
188     ! Gas phase enthalpy chnage from energy equation derivation.
189                       IF(M == 0) THEN
190                          llHORg = llHORg + CALC_H(T_g(IJK),0,N) * lRate
191     ! Solid phase enthalpy change from energy equation derivation.
192                       ELSE
193                          lHORs = lHORs + CALC_H(lTp,M,N) * lRate
194                       ENDIF
195                    ENDDO
196     
197     ! Apply enthalpy transfer associated with mass transfer to get the
198     ! complete heat of reaction for Reaction H.
199                    llHORg = llHORg - RxH
200                    lHORs = lHORs + RxH
201     
202     ! Convert the heat of reaction to the appropriate units (if SI), and
203     ! store in the global array.
204                    IF(UNITS == 'SI') THEN
205                       lHORg = lHORg + 4.183925d3*llHORg
206                       Q_Source(NP) = Q_Source(NP) - 4.183925d3*lHORs
207                    ELSE
208                       lHORg = lHORg + llHORg
209                       Q_Source(NP) = Q_Source(NP) - lHORs
210                    ENDIF
211                 ELSE
212     ! User-defined heat of reaction.
213                    HOR_g(IJK) = HOR_g(IJK) + &
214                       DES_Reaction(H)%HoR(0) * DES_RATES(H)
215                    Q_Source(NP) = Q_Source(NP) - &
216                       DES_Reaction(H)%HoR(pM) * DES_RATES(H)
217                 ENDIF
218              ENDIF
219     
220     ! Update rate of interphase mass transfer.
221     !---------------------------------------------------------------------//
222              LM = 1 + (pM - 1)*pM/2
223              lRPhase(LM) = lRPhase(LM) + &
224                 DES_RATES(H) * DES_Reaction(H)%rPHASE(LM)
225     
226           ENDDO RXN_LP ! Loop over reactions.
227     
228     ! Calculate the toal rate of formation and consumption for each species.
229     !---------------------------------------------------------------------//
230           IF(SPECIES_EQ(0)) THEN
231              SUMlRg = SUM(lRgp(:NMAX(0)) - lRgc(:NMAX(0)))
232           ELSE
233              DO H=1, NO_OF_DES_RXNS
234                 IF(DES_Reaction(H)%nPhases <= 0) CYCLE
235                 LM = 1 + ((pM-1)*pM)/2
236                 SUMlRg = SUMlRg + &
237                    DES_RATES(H) * DES_Reaction(H)%rPHASE(LM)
238              ENDDO
239           ENDIF
240     
241     ! Integrate over solids time step and store in global array. This
242     ! needs updated when interpolation is reintroduced into thermo code.
243     !---------------------------------------------------------------------//
244           DES_R_gp(IJK,:) = DES_R_gp(IJK,:) + lRgp(:) * DTSOLID
245           DES_R_gc(IJK,:) = DES_R_gc(IJK,:) + lRgc(:) * DTSOLID
246           DES_R_PHASE(IJK,:) = DES_R_PHASE(IJK,:) + lRPhase(:) * DTSOLID
247           DES_HOR_G(IJK) = DES_HOR_G(IJK) + lHoRg * DTSOLID
248           DES_SUM_R_g(IJK) = DES_SUM_R_g(IJK) + SUMlRg * DTSOLID
249     
250     
251           RETURN
252           END SUBROUTINE DES_RRATES0
253