File: /nfs/home/0/users/jenkins/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 implemenation
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     ! Gas phase species database names.
162           use rxns, only: SPECIES_g
163     ! Gas phase molecular weights.
164           use physprop, only: MW_g
165     ! Number of gas phase species.
166           use physprop, only: NMAX, NMAX_g
167     ! User specified: Constant gas phase specific heat
168           use physprop, only: C_PG0
169     ! User specified: Constant gas density
170           use physprop, only: RO_G0
171     ! User specified: Constant gas phase mixture molecular weight
172           use physprop, only: MW_AVG
173     
174     
175     ! Global Parameters:
176     !---------------------------------------------------------------------//
177     ! Maximum number of gas phase species.
178           USE param, only: DIM_N_g
179     ! Constants.
180           USE param1, only: UNDEFINED, UNDEFINED_I, UNDEFINED_C
181           USE param1, only: ZERO
182     
183     
184     ! Use the error manager for posting error messages.
185     !---------------------------------------------------------------------//
186           use error_manager
187     
188     
189           implicit none
190     
191     
192     ! Local Variables:
193     !---------------------------------------------------------------------//
194     ! Loop counter.
195           INTEGER :: N
196     
197     ! Flag that the energy equations are solved and constant gas phase
198     ! specific heat is undefined.
199     ! If true, a call to the thermochemical database is made.
200           LOGICAL EEQ_CPG
201     
202     ! Flag that the average molecular weight (MW_AVG) and constant gas
203     ! phase density are undefined.
204     ! If true, a call to the thermochemical database is made.
205           LOGICAL MWg_ROg
206     
207     ! Flag that the gas phase species equations are solved and the
208     ! molecular weight for a species is not given in the data file.
209     ! If true, a call to the thermochemical database is made.
210           LOGICAL SEQ_MWg
211     
212     
213     !......................................................................!
214     
215     
216     ! Initialize the error manager.
217           CALL INIT_ERR_MSG("CHECK_GAS_SPECIES")
218     
219     
220     ! Reconcile the new species input method with the legacy input method.
221           IF(SPECIES_EQ(0)) THEN
222     
223              IF(NMAX_g == UNDEFINED_I) THEN
224                 WRITE(ERR_MSG,1000) 'NMAX_g'
225                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
226              ELSEIF(NMAX_g > DIM_N_G) THEN
227                 WRITE(ERR_MSG,1001) 'NMAX_g', iVal(NMAX_g)
228                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
229              ELSE
230                 NMAX(0) = NMAX_g
231              ENDIF
232     ! Set the number of species to one if the species equations are not solved and
233     ! the number of species is not specified.
234           ELSE
235              NMAX(0) = merge(1, NMAX_g, NMAX_g == UNDEFINED_I)
236           ENDIF
237     
238     ! Flag that the energy equations are solved and specified solids phase
239     ! specific heat is undefined.
240           EEQ_CPG = (ENERGY_EQ .AND. C_PG0 == UNDEFINED)
241           IF(EEQ_CPG) THEN
242              WRITE(ERR_MSG,2000)
243              CALL FLUSH_ERR_MSG
244           ENDIF
245     
246      2000 FORMAT('Message: 2000 The energy equations are being solved ',   &
247              '(ENERGY_EQ) and',/'the constant gas specific heat is ',      &
248              'undefined (C_PG0). Thus, the thermo-',/'chemical database ', &
249              'will be used to gather specific heat data on the',/          &
250              'individual gas phase species.')
251     
252           MWg_ROg = .FALSE.
253           SEQ_MWg = .FALSE.
254           IF(MW_AVG == UNDEFINED) THEN
255              DO N=1,NMAX(0)
256                 IF(MW_g(N) == UNDEFINED) THEN
257                    IF(RO_G0 == UNDEFINED) MWg_ROg = .TRUE.
258                    IF(SPECIES_EQ(0)) SEQ_MWg = .TRUE.
259                 ENDIF
260              ENDDO
261           ENDIF
262     
263           IF(MWg_ROg) THEN
264              WRITE(ERR_MSG, 2001)
265              CALL FLUSH_ERR_MSG
266           ENDIF
267     
268      2001 FORMAT('Message 2001: MW_AVG and RO_G0 are undefined and one or',&
269              ' more species',/'molecular weights are undefined. The therm',&
270              'ochemical database will be',/'used in an attempt to gather ',&
271              'missing molecular weight data.')
272     
273           IF(SEQ_MWg) THEN
274              WRITE(ERR_MSG, 2002)
275              CALL FLUSH_ERR_MSG
276           ENDIF
277     
278      2002 FORMAT('Message 2002: One or more species molecular weights are',&
279              ' undefined and',/'the gas phase species equations are being',&
280              ' solved (SOLVE_EQ(0)). The',/'thermochemical database will ',&
281              'be used in an attempt to gather missing',/'molecular weight',&
282              ' data.')
283     
284     ! Initialize flag indicating the database was read for a species.
285           rDatabase(0,:) = .FALSE.
286     
287           IF(EEQ_CPG .OR. SEQ_MWg .OR. MWg_ROg) THEN
288     
289              WRITE(ERR_MSG, 3000)
290              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
291     
292      3000 FORMAT('Message 3000: Searching thermochemical databases for ',  &
293              'gas phase',/'species data.',/'  ')
294     
295              DO N = 1, NMAX(0)
296                 IF(EEQ_CPG .OR. MW_g(N) == UNDEFINED) THEN
297     ! Notify the user of the reason the thermochemical database is used.
298     ! Flag that the species name is not provided.
299                    IF(SPECIES_g(N) == UNDEFINED_C) THEN
300                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_g',N))
301                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
302                    ENDIF
303     ! Update the log files.
304                    WRITE(ERR_MSG, 3001) N, trim(SPECIES_g(N))
305                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
306                    3001 FORMAT(/2x,'>',I3,': Species: ',A)
307     ! Read the database.
308                    CALL READ_DATABASE(0, N, SPECIES_g(N), MW_g(N))
309     ! Flag variable to stating that the database was read.
310                    rDatabase(0,N) = .TRUE.
311                 ENDIF
312     
313              ENDDO ! Loop over species
314              CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
315           ENDIF
316     
317     ! Verify that no additional species information was given.
318           DO N = NMAX(0) + 1, DIM_N_G
319              IF(MW_G(N) /= UNDEFINED) THEN
320                 WRITE(ERR_MSG, 1002) trim(iVar('MW_g',N))
321                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
322              ENDIF
323           ENDDO
324     
325           CALL FINL_ERR_MSG
326     
327           RETURN
328     
329      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
330              'correct the mfix.dat file.')
331     
332      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
333              'Please correct the mfix.dat file.')
334     
335      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
336              'Please correct the mfix.dat file.')
337     
338           END SUBROUTINE CHECK_GAS_SPECIES
339     
340     
341     !----------------------------------------------------------------------!
342     ! Subroutine: CHECK_GAS_SPECIES_LEGACY                                 !
343     ! Purpose: These are legacy checks for using rrates.f to specify       !
344     ! chemcial reactions.                                                  !
345     !                                                                      !
346     ! Author: J. Musser                                  Date: 03-FEB-14   !
347     !----------------------------------------------------------------------!
348           SUBROUTINE CHECK_GAS_SPECIES_LEGACY
349     
350     
351     ! Global Variables:
352     !---------------------------------------------------------------------//
353     ! Flag: Solve species equations
354           use run, only: SPECIES_EQ
355     ! Gas phase molecular weights.
356           use physprop, only: MW_g
357     ! Number of gas phase species.
358           use physprop, only: NMAX, NMAX_g
359     ! Flag: Database was read. (legacy)
360           use physprop, only: DATABASE_READ
361     
362     
363     ! Global Parameters:
364     !---------------------------------------------------------------------//
365     ! Maximum number of gas phase species.
366           USE param, only: DIM_N_g
367     ! Constants.
368           USE param1, only: UNDEFINED_I, UNDEFINED, ZERO
369     
370     
371     ! Use the error manager for posting error messages.
372     !---------------------------------------------------------------------//
373           use error_manager
374     
375     
376           implicit none
377     
378     
379     ! Local Variables:
380     !---------------------------------------------------------------------//
381     ! Loop counter.
382           INTEGER :: N
383     
384     
385     !......................................................................!
386     
387     
388     ! Initialize the error manager.
389           CALL INIT_ERR_MSG("CHECK_GAS_SPECIES_LEGACY")
390     
391     
392     ! Reconcile the new species input method with the legacy input method.
393           IF(SPECIES_EQ(0)) THEN
394     ! Legacy checks for species equations.
395              IF(NMAX_g /= UNDEFINED_I) THEN
396                 WRITE(ERR_MSG,2000) 'NMAX_g', 'undefined'
397                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
398              ELSEIF(NMAX(0) == UNDEFINED_I) THEN
399                 WRITE(ERR_MSG,2000) trim(iVar('NMAX',0)), 'specified'
400                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
401              ELSEIF(NMAX(0) > DIM_N_G) THEN
402                 WRITE(ERR_MSG,1001) trim(iVar('NMAX',0)), iVal(NMAX(0))
403                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
404              ENDIF
405     ! Set the number of species to one if the species equations are not
406     ! solved and the number of species is not specified.
407           ELSE
408              IF(NMAX(0) == UNDEFINED_I) NMAX(0) = 1
409           ENDIF
410     
411     ! Check MW_g if solids species are present
412           DO N = 1, NMAX(0)
413              IF(MW_G(N) == UNDEFINED) THEN
414                 WRITE(ERR_MSG,2000)trim(iVar('MW_g',N)), 'specified'
415                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
416              ELSEIF(MW_G(N) <= ZERO) THEN
417                 WRITE(ERR_MSG,1001)trim(iVar('MW_g',N)), iVal(MW_G(N))
418                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
419              ENDIF
420           ENDDO ! Loop over species
421           DO N = NMAX(0) + 1, DIM_N_G
422              IF(MW_G(N) /= UNDEFINED) 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
427     
428           CALL FINL_ERR_MSG
429     
430     ! Set the legacy database flag. (Also in check_solids_common_all)
431           DATABASE_READ = .FALSE.
432     
433           RETURN
434     
435      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
436              'Please correct the mfix.dat file.')
437     
438      2000 FORMAT('Error 2000: Invalid input. ',A,' must be ',A,/'when ',    &
439              'USE_RRATES is .TRUE.'/,'Please correct the mfix.dat file')
440     
441           END SUBROUTINE CHECK_GAS_SPECIES_LEGACY
442     
443