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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: CHECK_GAS_PHASE                                        !
4     !  Purpose: Check the gas phase input section                          !
5     !                                                                      !
6     !  Author: P.Nicoletti                                Date: 02-DEC-91  !
7     !          J.Musser                                   Date: 01-FEB-14  !
8     !                                                                      !
9     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
10           SUBROUTINE CHECK_GAS_PHASE
11     
12     
13     ! Global Variables:
14     !---------------------------------------------------------------------//
15     ! Flag: Solve species equations.
16           use run, only: SPECIES_EQ
17     ! Flag: Use legacy reaction rates implementation
18           use rxns, only: USE_RRATES
19     ! User specified: Constant gas viscosity
20           use physprop, only: MU_G0
21     ! User specified: Constant gas thermal conductivity
22           use physprop, only: K_G0
23     ! User specified: Constant gas mixture diffusion coefficient
24           use physprop, only: DIF_G0
25     ! User specified: Constant gas specific heat
26           use physprop, only: C_PG0
27     ! User specified: Constant gas density
28           use physprop, only: RO_G0
29     ! User specified: Constant gas mixture molecular weight
30           use physprop, only: MW_AVG
31     
32     
33     ! Global Parameters:
34     !---------------------------------------------------------------------//
35     ! Parameter constants
36           use param1, only: UNDEFINED, ZERO
37     
38     ! Use the error manager for posting error messages.
39     !---------------------------------------------------------------------//
40           use error_manager
41     
42     
43           IMPLICIT NONE
44     
45     
46     ! Local Variables:
47     !---------------------------------------------------------------------//
48     ! NONE
49     
50     !......................................................................!
51     
52     
53     ! Initialize the error manager.
54           CALL INIT_ERR_MSG("CHECK_GAS_PHASE")
55     
56     
57     ! CHECK MU_g0
58           IF (MU_G0 <= ZERO) THEN
59              WRITE(ERR_MSG,1001) 'MU_G0', iVal(MU_G0)
60              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
61           ENDIF
62     
63     ! CHECK K_g0
64           IF (K_G0 < ZERO) THEN
65              WRITE(ERR_MSG,1001) 'K_G0', iVal(K_G0)
66              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
67           ENDIF
68     
69     ! CHECK C_pg0
70           IF (C_PG0 < ZERO) THEN
71              WRITE(ERR_MSG,1001) 'C_PG0', iVal(C_PG0)
72              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
73           ENDIF
74     
75     ! CHECK DIF_g0
76           IF (DIF_G0 < ZERO) THEN
77              WRITE(ERR_MSG,1001) 'DIF_g0', iVal(DIF_g0)
78              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
79           ENDIF
80     
81     ! Check the input specifications for gas species.
82           IF(USE_RRATES)THEN
83              CALL CHECK_GAS_SPECIES_LEGACY
84           ELSE
85              CALL CHECK_GAS_SPECIES
86           ENDIF
87     
88     ! CHECK MW_AVG
89           IF (SPECIES_EQ(0)) THEN
90     ! MW_AVG is defined and the gas phase species equations are solved, then
91     ! the user specified average molecular weight is ignored. The gas phase
92     ! mixture molecular weight (MW_MIX_g) is used instead.
93              IF (MW_AVG /= UNDEFINED) THEN
94                 WRITE (ERR_MSG, 1100) 'solving species equations'
95                 CALL FLUSH_ERR_MSG
96                 MW_AVG = UNDEFINED
97              ENDIF
98           ELSE
99     ! When the species equations are not solved and the gas phase is
100     ! compressible, verify that the user provided average molecular weight
101     ! has a physical value. (This does not include the case where MW_AVG
102     ! is UNDEFINED.)
103              IF (RO_G0 == UNDEFINED) THEN
104                 IF (MW_AVG <= ZERO) THEN
105                    WRITE(ERR_MSG, 1001) 'MW_AVG', iVal(MW_AVG)
106                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
107                 ENDIF
108              ELSE
109     ! Gas density for incompressible flows must be positive.
110                 IF (RO_G0 < ZERO) THEN
111                    WRITE(ERR_MSG, 1001) 'RO_G0', iVal(RO_G0)
112                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
113                 ENDIF
114     ! Incompressible simulations do not need MW_AVG. Notify the user that
115     ! the provided data is ignored.
116                 IF (MW_AVG /= UNDEFINED)THEN
117                    WRITE(ERR_MSG, 1100) 'RO_g0 is specified'
118                    CALL FLUSH_ERR_MSG
119                 ENDIF
120     
121              ENDIF
122           ENDIF
123     
124     
125     ! Finalize the error manager
126           CALL FINL_ERR_MSG
127     
128     
129           RETURN
130     
131      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
132                 'correct the mfix.dat file.')
133     
134      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/      &
135              'Please correct the mfix.dat file.')
136     
137     
138      1100 FORMAT('Message 2000: MW_AVG is not needed when ',A,'.')
139     
140           END SUBROUTINE CHECK_GAS_PHASE
141     
142     
143     
144     !----------------------------------------------------------------------!
145     ! Subroutine: CHECK_GAS_SPECIES                                        !
146     ! Purpose: Gas phase species checks.                                   !
147     !                                                                      !
148     ! Author: J. Musser                                  Date: 07-FEB-14   !
149     !----------------------------------------------------------------------!
150           SUBROUTINE CHECK_GAS_SPECIES
151     
152     
153     ! Global Variables:
154     !---------------------------------------------------------------------//
155     ! Flag: Solve energy equations
156           use run, only: ENERGY_EQ
157     ! Flag: Solve species equations
158           use run, only: SPECIES_EQ
159     ! Flag: Database for phase X was read for species Y
160           use rxns, only: rDatabase
161     ! Flag: Code is reinitializing
162           use run, only: REINITIALIZING
163     ! Gas phase species database names.
164           use rxns, only: SPECIES_g
165     ! Gas phase molecular weights.
166           use physprop, only: MW_g
167     ! Number of gas phase species.
168           use physprop, only: NMAX, NMAX_g
169     ! User specified: Constant gas phase specific heat
170           use physprop, only: C_PG0
171     ! User specified: Constant gas density
172           use physprop, only: RO_G0
173     ! User specified: Constant gas phase mixture molecular weight
174           use physprop, only: MW_AVG
175     
176     
177     ! Global Parameters:
178     !---------------------------------------------------------------------//
179     ! Maximum number of gas phase species.
180           USE param, only: DIM_N_g
181     ! Constants.
182           USE param1, only: UNDEFINED, UNDEFINED_I, UNDEFINED_C
183           USE param1, only: ZERO
184     
185     
186     ! Use the error manager for posting error messages.
187     !---------------------------------------------------------------------//
188           use error_manager
189     
190     
191           implicit none
192     
193     
194     ! Local Variables:
195     !---------------------------------------------------------------------//
196     ! Loop counter.
197           INTEGER :: N
198     
199     ! Flag that the energy equations are solved and constant gas phase
200     ! specific heat is undefined.
201     ! If true, a call to the thermochemical database is made.
202           LOGICAL EEQ_CPG
203     
204     ! Flag that the average molecular weight (MW_AVG) and constant gas
205     ! phase density are undefined.
206     ! If true, a call to the thermochemical database is made.
207           LOGICAL MWg_ROg
208     
209     ! Flag that the gas phase species equations are solved and the
210     ! molecular weight for a species is not given in the data file.
211     ! If true, a call to the thermochemical database is made.
212           LOGICAL SEQ_MWg
213     
214     
215     !......................................................................!
216     
217     
218     ! Initialize the error manager.
219           CALL INIT_ERR_MSG("CHECK_GAS_SPECIES")
220     
221     
222     ! Reconcile the new species input method with the legacy input method.
223           IF(SPECIES_EQ(0)) THEN
224     
225              IF(NMAX_g == UNDEFINED_I) THEN
226                 WRITE(ERR_MSG,1000) 'NMAX_g'
227                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
228              ELSEIF(NMAX_g > DIM_N_G) THEN
229                 WRITE(ERR_MSG,1001) 'NMAX_g', iVal(NMAX_g)
230                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
231              ELSE
232                 NMAX(0) = NMAX_g
233              ENDIF
234     ! Set the number of species to one if the species equations are not solved and
235     ! the number of species is not specified.
236           ELSE
237              NMAX(0) = merge(1, NMAX_g, NMAX_g == UNDEFINED_I)
238           ENDIF
239     
240     ! Flag that the energy equations are solved and specified solids phase
241     ! specific heat is undefined.
242           EEQ_CPG = (ENERGY_EQ .AND. C_PG0 == UNDEFINED)
243           IF(EEQ_CPG .AND. .NOT.REINITIALIZING) THEN
244              WRITE(ERR_MSG,2000)
245              CALL FLUSH_ERR_MSG
246           ENDIF
247     
248      2000 FORMAT('Message: 2000 The energy equations are being solved ',   &
249              '(ENERGY_EQ) and',/'the constant gas specific heat is ',      &
250              'undefined (C_PG0). Thus, the thermo-',/'chemical database ', &
251              'will be used to gather specific heat data on the',/          &
252              'individual gas phase species.')
253     
254           MWg_ROg = .FALSE.
255           SEQ_MWg = .FALSE.
256           IF(MW_AVG == UNDEFINED) THEN
257              DO N=1,NMAX(0)
258                 IF(MW_g(N) == UNDEFINED) THEN
259                    IF(RO_G0 == UNDEFINED) MWg_ROg = .TRUE.
260                    IF(SPECIES_EQ(0)) SEQ_MWg = .TRUE.
261                 ENDIF
262              ENDDO
263           ENDIF
264     
265           IF(MWg_ROg .AND. REINITIALIZING) THEN
266              WRITE(ERR_MSG, 2001)
267              CALL FLUSH_ERR_MSG
268           ENDIF
269     
270      2001 FORMAT('Message 2001: MW_AVG and RO_G0 are undefined and one or',&
271              ' more species',/'molecular weights are undefined. The therm',&
272              'ochemical database will be',/'used in an attempt to gather ',&
273              'missing molecular weight data.')
274     
275           IF(SEQ_MWg .AND. REINITIALIZING) THEN
276              WRITE(ERR_MSG, 2002)
277              CALL FLUSH_ERR_MSG
278           ENDIF
279     
280      2002 FORMAT('Message 2002: One or more species molecular weights are',&
281              ' undefined and',/'the gas phase species equations are being',&
282              ' solved (SOLVE_EQ(0)). The',/'thermochemical database will ',&
283              'be used in an attempt to gather missing',/'molecular weight',&
284              ' data.')
285     
286     ! Initialize flag indicating the database was read for a species.
287           rDatabase(0,:) = .FALSE.
288     
289           IF(EEQ_CPG .OR. SEQ_MWg .OR. MWg_ROg) THEN
290     
291              IF(.NOT.REINITIALIZING) THEN
292                 WRITE(ERR_MSG, 3000)
293                 CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
294              ENDIF
295     
296      3000 FORMAT('Message 3000: Searching thermochemical databases for ',  &
297              'gas phase',/'species data.',/'  ')
298     
299              DO N = 1, NMAX(0)
300                 IF(EEQ_CPG .OR. MW_g(N) == UNDEFINED) THEN
301     ! Notify the user of the reason the thermochemical database is used.
302     ! Flag that the species name is not provided.
303                    IF(SPECIES_g(N) == UNDEFINED_C) THEN
304                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_g',N))
305                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
306                    ENDIF
307     ! Update the log files.
308                    IF(.NOT.REINITIALIZING) THEN
309                       WRITE(ERR_MSG, 3001) N, trim(SPECIES_g(N))
310                       CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
311                    ENDIF
312                    3001 FORMAT(/2x,'>',I3,': Species: ',A)
313     ! Read the database.
314                    CALL READ_DATABASE(0, N, SPECIES_g(N), MW_g(N))
315     ! Flag variable to stating that the database was read.
316                    rDatabase(0,N) = .TRUE.
317                 ENDIF
318     
319              ENDDO ! Loop over species
320              IF(.NOT.REINITIALIZING) CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
321           ENDIF
322     
323     ! Verify that no additional species information was given.
324           DO N = NMAX(0) + 1, DIM_N_G
325              IF(MW_G(N) /= UNDEFINED) THEN
326                 WRITE(ERR_MSG, 1002) trim(iVar('MW_g',N))
327                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
328              ENDIF
329           ENDDO
330     
331           CALL FINL_ERR_MSG
332     
333           RETURN
334     
335      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
336              'correct the mfix.dat file.')
337     
338      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
339              'Please correct the mfix.dat file.')
340     
341      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
342              'Please correct the mfix.dat file.')
343     
344           END SUBROUTINE CHECK_GAS_SPECIES
345     
346     
347     !----------------------------------------------------------------------!
348     ! Subroutine: CHECK_GAS_SPECIES_LEGACY                                 !
349     ! Purpose: These are legacy checks for using rrates.f to specify       !
350     ! chemical reactions.                                                  !
351     !                                                                      !
352     ! Author: J. Musser                                  Date: 03-FEB-14   !
353     !----------------------------------------------------------------------!
354           SUBROUTINE CHECK_GAS_SPECIES_LEGACY
355     
356     
357     ! Global Variables:
358     !---------------------------------------------------------------------//
359     ! Flag: Solve species equations
360           use run, only: SPECIES_EQ
361     ! Gas phase molecular weights.
362           use physprop, only: MW_g
363     ! Number of gas phase species.
364           use physprop, only: NMAX, NMAX_g
365     ! Flag: Database was read. (legacy)
366           use physprop, only: DATABASE_READ
367     
368     
369     ! Global Parameters:
370     !---------------------------------------------------------------------//
371     ! Maximum number of gas phase species.
372           USE param, only: DIM_N_g
373     ! Constants.
374           USE param1, only: UNDEFINED_I, UNDEFINED, ZERO
375     
376     
377     ! Use the error manager for posting error messages.
378     !---------------------------------------------------------------------//
379           use error_manager
380     
381     
382           implicit none
383     
384     
385     ! Local Variables:
386     !---------------------------------------------------------------------//
387     ! Loop counter.
388           INTEGER :: N
389     
390     
391     !......................................................................!
392     
393     
394     ! Initialize the error manager.
395           CALL INIT_ERR_MSG("CHECK_GAS_SPECIES_LEGACY")
396     
397     
398     ! Reconcile the new species input method with the legacy input method.
399           IF(SPECIES_EQ(0)) THEN
400     ! Legacy checks for species equations.
401              IF(NMAX_g /= UNDEFINED_I) THEN
402                 WRITE(ERR_MSG,2000) 'NMAX_g', 'undefined'
403                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
404              ELSEIF(NMAX(0) == UNDEFINED_I) THEN
405                 WRITE(ERR_MSG,2000) trim(iVar('NMAX',0)), 'specified'
406                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
407              ELSEIF(NMAX(0) > DIM_N_G) THEN
408                 WRITE(ERR_MSG,1001) trim(iVar('NMAX',0)), iVal(NMAX(0))
409                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
410              ENDIF
411     ! Set the number of species to one if the species equations are not
412     ! solved and the number of species is not specified.
413           ELSE
414              IF(NMAX(0) == UNDEFINED_I) NMAX(0) = 1
415           ENDIF
416     
417     ! Check MW_g if solids species are present
418           DO N = 1, NMAX(0)
419              IF(MW_G(N) == UNDEFINED) THEN
420                 WRITE(ERR_MSG,2000)trim(iVar('MW_g',N)), 'specified'
421                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
422              ELSEIF(MW_G(N) <= ZERO) THEN
423                 WRITE(ERR_MSG,1001)trim(iVar('MW_g',N)), iVal(MW_G(N))
424                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
425              ENDIF
426           ENDDO ! Loop over species
427           DO N = NMAX(0) + 1, DIM_N_G
428              IF(MW_G(N) /= UNDEFINED) THEN
429                 WRITE(ERR_MSG,1001)trim(iVar('MW_g',N)), iVal(MW_G(N))
430                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
431              ENDIF
432           ENDDO
433     
434           CALL FINL_ERR_MSG
435     
436     ! Set the legacy database flag. (Also in check_solids_common_all)
437           DATABASE_READ = .FALSE.
438     
439           RETURN
440     
441      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
442              'Please correct the mfix.dat file.')
443     
444      2000 FORMAT('Error 2000: Invalid input. ',A,' must be ',A,/'when ',    &
445              'USE_RRATES is .TRUE.'/,'Please correct the mfix.dat file')
446     
447           END SUBROUTINE CHECK_GAS_SPECIES_LEGACY
448     
449