File: RELATIVE:/../../../mfix.git/model/check_data/check_chemical_rxns.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: CHECK_CHEMICAL_RXNS                                    !
4     !  Author: J.Musser                                   Date: 21-MAR-14  !
5     !                                                                      !
6     !  Purpose: Check chemical reactions specifications                    !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE CHECK_CHEMICAL_RXNS
10     
11     ! User defined reaction names from reaction blocks @(RXNS)
12           use parse, only: RXN_NAME, DES_RXN_NAME
13     
14           use parse, only: RXN_CHEM_EQ, DES_RXN_CHEM_EQ
15           use parse, only: usrDH, DES_usrDH
16           use parse, only: usrfDH, DES_usrfDH
17     
18     
19     ! Number of continuum reactions and data object
20           use rxns, only: NO_OF_RXNS, REACTION
21     ! Number of discrete reactions and data object
22           use des_rxns, only: NO_OF_DES_RXNS, DES_REACTION
23     ! User specified species names and aliases:
24           use rxns, only: SPECIES_g, SPECIES_ALIAS_g
25           use rxns, only: SPECIES_s, SPECIES_ALIAS_s
26     
27     ! Number of continuum solids
28           use physprop, only: SMAX
29     ! Number of discrete solids
30           use discretelement, only: DES_MMAX
31     ! Number of species comprising each phase
32           use physprop, only: NMAX
33     
34     !
35           use param1, only: UNDEFINED_I
36     
37           use rxn_com, only: checkSpeciesInc
38           use rxn_com, only: checkDuplicateAliases
39     
40     
41           use error_manager
42     
43           IMPLICIT NONE
44     
45     ! Error flag
46           INTEGER :: IER
47     
48     ! Local representation of the number of solids phases.
49           INTEGER :: lMMAX
50     
51     ! Undefined indicates that no reaction block was found in the deck file.
52           IF(NO_OF_RXNS == UNDEFINED_I) NO_OF_RXNS = 0
53           IF(NO_OF_DES_RXNS == UNDEFINED_I) NO_OF_DES_RXNS = 0
54     
55     ! If there are no chemical reactions, then skip this routine.
56           IF(NO_OF_RXNS + NO_OF_DES_RXNS == 0) RETURN
57     
58           CALL INIT_ERR_MSG('CHECK_CHEMICAL_RXNS')
59     
60     ! Allocate the arrays as a work-around for Intel compiler with debug.
61           IF(NO_OF_RXNS == 0) allocate(RXN_NAME(1))
62           IF(NO_OF_DES_RXNS == 0) allocate(DES_RXN_NAME(1))
63     
64     ! Initialize the number of solids phases.
65           lMMAX = SMAX + DES_MMAX
66     
67     ! Verify that the species aliases are unique.
68           CALL checkDuplicateAliases(NMAX(0), SPECIES_ALIAS_g(:), &
69              lMMAX, NMAX(1:lMMAX), SPECIES_ALIAS_s(:,:))
70     
71     ! Verify that species aliases in the datafile match those in the
72     ! species.inc file.
73           CALL checkSpeciesInc(NMAX(0), SPECIES_ALIAS_g(:), lMMAX,         &
74              NMAX(1:lMMAX), SPECIES_ALIAS_s(:,:), NO_OF_RXNS, RXN_NAME(:), &
75              NO_OF_DES_RXNS, DES_RXN_NAME)
76     
77     
78           IF(NO_OF_RXNS > 0) THEN
79              CALL CHECK_CHEMICAL_RXNS_COMMON(NO_OF_RXNS, RXN_NAME,         &
80                 RXN_CHEM_EQ, usrDH, usrfDH, REACTION)
81           ENDIF
82     
83           IF(NO_OF_DES_RXNS > 0) THEN
84              CALL CHECK_CHEMICAL_RXNS_COMMON(NO_OF_DES_RXNS, DES_RXN_NAME, &
85                 DES_RXN_CHEM_EQ, DES_usrDH, DES_usrfDH, DES_REACTION)
86           ENDIF
87     
88           CALL FINL_ERR_MSG
89     
90           RETURN
91     
92           CONTAINS
93     
94     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
95     !                                                                      !
96     !  Module name: CHECK_CHEMICAL_RXNS_COMMON                             !
97     !  Author: J.Musser                                   Date: 21-MAR-14  !
98     !                                                                      !
99     !  Purpose: Check chemical reactions specifications                    !
100     !                                                                      !
101     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
102           SUBROUTINE CHECK_CHEMICAL_RXNS_COMMON(COUNT, NAME, CHEM_EQ, DH,  &
103              fDH, RXN_ARRAY)
104     
105     ! Runtime flags for solving energy and species equations.
106           use run, only: ENERGY_EQ, SPECIES_EQ
107     ! Definition of derived data type
108           use rxn_com, only: REACTION_BLOCK
109     ! User specified constant specific heats:
110           use physprop, only: C_PG0, C_PS0
111     ! Molecular weights:
112           use physprop, only: MW_g, MW_s
113     ! Flag marking when the thermochemical database is read.
114           use rxns, only: rDatabase
115     
116           use param, only: DIM_M, DIMENSION_RXN
117     
118     
119           use parse, only: setReaction
120           use rxn_com, only: checkThermoReqs
121           use rxn_com, only: checkMassBalance
122           use rxn_com, only: calcInterphaseTxfr
123           use rxn_com, only: WRITE_RXN_SUMMARY
124     
125     
126     
127           use error_manager
128     
129           IMPLICIT NONE
130     
131           INTEGER, INTENT(IN) :: COUNT
132     
133     ! Reaction Names from mfix.dat file:
134           CHARACTER(len=32), INTENT(IN) ::  NAME(DIMENSION_RXN)
135     ! Chemical equations:
136           CHARACTER(len=512), INTENT(IN) :: CHEM_EQ(DIMENSION_RXN)
137     ! User defined heat of reaction:
138           DOUBLE PRECISION, INTENT(IN) :: DH(DIMENSION_RXN)
139     ! User defined heat of reaction partitions.
140           DOUBLE PRECISION, INTENT(IN) :: fDH(DIMENSION_RXN,0:DIM_M)
141     
142     ! Array of reaction data objects.
143           TYPE(REACTION_BLOCK), TARGET, ALLOCATABLE :: RXN_ARRAY(:)
144     
145     
146     
147     ! loop/variable indices1
148           INTEGER :: L
149     
150           TYPE(REACTION_BLOCK), POINTER :: This
151     
152           DOUBLE PRECISION netMassTransfer(0:DIM_M)
153     
154     
155     
156     
157           CALL INIT_ERR_MSG('CHECK_CHEMICAL_RXNS_COMMON')
158     
159     
160     ! Allocate reaction blocks.
161           allocate(RXN_ARRAY(COUNT))
162     
163     
164     
165     
166     
167     ! Loop over reaction data pulled from data file.
168           DO L=1, COUNT
169     
170              This => RXN_ARRAY(L)
171     
172     ! Store the reaction name.
173              This%Name = trim(NAME(L))
174     
175     ! This check should not be necessary. Pre-processing by make_mfix and
176     ! reading the data file (PARSE_RXN) should have already caught any
177     ! issues.
178              IF(len_trim(This%Name) == 0) THEN
179                 WRITE(ERR_MSG, 1100) L
180                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
181              ENDIF
182     
183      1100 FORMAT('Error 1100: No reaction name identified for reaction ',  &
184              I3,'.',/'This should have been caught during the parsing ',   &
185              'routines.')
186     
187     ! Store the chemical equation.
188              This%ChemEq = trim(CHEM_EQ(L))
189     
190     ! Verify that a chemical equation was given in the data file.
191              IF(len_trim(This%ChemEq) == 0) THEN
192                 WRITE(*,1101) trim(This%Name)
193                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
194              ENDIF
195     
196      1101 FORMAT('Error 1101: No chemical equation identified for ',       &
197              'reaction ',A,'.',/'Please correct the mfix.dat file.')
198     
199     ! Take the data read from the data file and populate the reaction block.
200              CALL setReaction(This, NMAX(0), SPECIES_ALIAS_g(:),lMMAX,     &
201                 NMAX(1:lMMAX), SPECIES_ALIAS_s(:,:), DH(L), fDH(L,:))
202     
203     ! If the energy equations are not being solved and a user provided
204     ! heat of reaction is given, flag error and exit.
205              IF(.NOT.ENERGY_EQ .AND. .NOT.This%Calc_DH) THEN
206                 WRITE(ERR_MSG,1200) trim(This%Name)
207                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
208              ENDIF
209     
210      1200 FORMAT('Error 1200: Inconsistent user input. Energy equations ', &
211              'are NOT being',/'solved and a user defined heat of reaction',&
212              ' was detected',' for chemical',/' reaction ',A,'.',/'Please',&
213              ' correct the mfix.dat file.')
214     
215     ! Skip empty reactions.
216              IF(This%nSpecies == 0 .AND. This%nPhases == 0) THEN
217                 CYCLE
218     
219     ! Something went wrong while parsing the reaction. This is a sanity
220     ! check and should never be true.
221              ELSEIF((This%nPhases == 0 .AND. This%nSpecies /= 0) .OR.      &
222                 (This%nPhases /= 0 .AND. This%nSpecies == 0)) THEN
223     
224                 WRITE(ERR_MSG,1201) trim(This%Name), This%nPhases,         &
225                    This%nSpecies
226                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
227              ENDIF
228     
229      1201 FORMAT('Error 1201: Illogical data returned from setReaction ',  &
230              'for chemical',/'reaction',1X,A,'.',//' Number of phases ',   &
231              'identified: ',I3,/'Number of species identified: ',I3,//,    &
232              'Please check the mfix.dat file.')
233     
234     ! Verify that the necessary information for each species in the reaction
235     ! was defined.
236              CALL checkThermoReqs(This, SPECIES_g, SPECIES_s, rDatabase,   &
237                 MW_G, MW_S, C_PG0, C_PS0)
238     
239     
240     ! Verify Mass Balance (Mass of Reactants = Mass of Products)
241     !---------------------------------------------------------------------//
242              IER = 0
243              CALL checkMassBalance('CHECK_CHEMICAL_RXNS', This, &
244                 netMassTransfer(:), IER)
245              IF(IER /= 0) THEN
246                 CALL WRITE_RXN_SUMMARY(This, SPECIES_ALIAS_g(:), &
247                    SPECIES_ALIAS_s(:,:), .TRUE.)
248              ENDIF
249     
250     ! Determine interphase exchanges
251     !---------------------------------------------------------------------//
252              CALL calcInterphaseTxfr('CHECK_CHEMICAL_RXNS', This,   &
253                 netMassTransfer(:), ENERGY_EQ, SPECIES_EQ(:), &
254                 SPECIES_ALIAS_g(:), lMMAX, SPECIES_ALIAS_s(:,:))
255           ENDDO
256     
257     ! Write a summary of the chemical reactions
258     !---------------------------------------------------------------------//
259           DO L=1, COUNT
260              This => RXN_ARRAY(L)
261              CALL WRITE_RXN_SUMMARY(This, SPECIES_ALIAS_g(:), &
262                 SPECIES_ALIAS_s(:,:), .FALSE.)
263           ENDDO
264     
265           CALL FINL_ERR_MSG
266     
267           RETURN
268           END SUBROUTINE CHECK_CHEMICAL_RXNS_COMMON
269     
270     
271     
272     
273           END SUBROUTINE CHECK_CHEMICAL_RXNS
274     
275