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