File: N:\mfix\model\check_data\check_solids_common_all.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: CHECK_SOLIDS_COMMON_ALL                                 !
4     !  Purpose: Check the solid phase input that is common to all solids   !
5     !  phase models.                                                       !
6     !                                                                      !
7     !    ****** DO NOT PUT MODEL SPECIFIC CHECKS IN THIS ROUTINE ******    !
8     !                                                                      !
9     !  Use the companion routines for checks specific to a particular      !
10     !  solids phase model:                                                 !
11     !                                                                      !
12     !    > CHECK_SOLIDS_CONTINUUM :: TFM solids phase model                !
13     !    > CHECK_SOLIDS_DEM       :: DEM solids phase model                !
14     !    > CHECK_SOLIDS_MPPIC     :: MPPIC solids phase model              !
15     !                                                                      !
16     !  Author: J.Musser                                  Date: 03-FEB-14   !
17     !                                                                      !
18     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
19           SUBROUTINE CHECK_SOLIDS_COMMON_ALL
20     
21     
22     ! Global Variables:
23     !---------------------------------------------------------------------//
24           use run, only: energy_eq, species_eq
25     ! Flag: Use legacy rrates implementation.
26           use rxns, only: USE_RRATES
27     ! Number of continuum solids phases.
28           use physprop, only: SMAX, MMAX
29     ! Number of discrete (DEM/MPPIC) solids.
30           use discretelement, only: DES_MMAX
31     ! User specified: Constant solids specific heat.
32           use physprop, only: C_PS0
33     ! User specified: Constant solids thermal conductivity.
34           use physprop, only: K_S0
35     ! User specified: Initial solids diameter.
36           use physprop, only: D_P0
37           use physprop, only: mu_s0, dif_s0
38           use mms, only: use_mms
39     
40     ! Global Parameters:
41     !---------------------------------------------------------------------//
42     ! Maximum number of solids phases.
43           use param, only: DIM_M
44     ! Parameter constants
45           use param1, only: UNDEFINED, ZERO
46     
47     
48     ! Global Module procedures:
49     !---------------------------------------------------------------------//
50           use error_manager
51     
52     
53           implicit none
54     
55     
56     ! Local Variables:
57     !---------------------------------------------------------------------//
58     ! Loop counters.
59           INTEGER :: M
60     ! Total number of all solids
61           INTEGER :: MMAX_L
62     
63     !......................................................................!
64     
65     ! Initialize the error manager.
66           CALL INIT_ERR_MSG("CHECK_SOLIDS_COMMON_ALL")
67     
68     ! Set the number of solids phases to be checked.
69           MMAX_L = SMAX + DES_MMAX
70     
71     ! Check D_p0
72           DO M = 1, MMAX_L
73              IF(D_P0(M) == UNDEFINED) THEN
74                 WRITE(ERR_MSG, 1000) trim(iVar('D_p0',M))
75                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
76              ELSEIF(D_P0(M) <= ZERO)THEN
77                 WRITE(ERR_MSG, 1001) trim(iVar('D_p0',M)), iVal(D_P0(M))
78                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
79              ENDIF
80           ENDDO
81     
82           DO M = MMAX_L+1, DIM_M
83              IF(D_P0(M) /= UNDEFINED)THEN
84                 WRITE(ERR_MSG,1002) trim(iVar('D_p0',M))
85                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
86              ENDIF
87           ENDDO
88     
89     ! Check K_s0
90           DO M=1, MMAX_L
91              IF (K_S0(M) < ZERO) THEN
92                 WRITE(ERR_MSG, 1001) trim(iVar('K_s0',M)), iVal(K_s0(M))
93                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
94              ENDIF
95           ENDDO
96     
97           DO M = MMAX_L+1, DIM_M
98              IF(K_s0(M) /= UNDEFINED)THEN
99                 WRITE(ERR_MSG,1002) trim(iVar('K_s0',M))
100                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
101              ENDIF
102           ENDDO
103     
104     ! Check C_ps0
105           DO M=1, MMAX_L
106              IF (C_PS0(M) < ZERO) THEN
107                 WRITE(ERR_MSG, 1001) trim(iVar('C_ps0',M)), iVal(C_ps0(M))
108                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
109              ENDIF
110           ENDDO
111     
112           DO M = MMAX_L+1, DIM_M
113              IF(C_ps0(M) /= UNDEFINED)THEN
114                 WRITE(ERR_MSG,1002) trim(iVar('C_ps0',M))
115                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
116              ENDIF
117           ENDDO
118     
119     ! Check the input specifications for solids species.
120           IF(USE_RRATES)THEN
121              CALL CHECK_SOLIDS_SPECIES_LEGACY(MMAX_L)
122           ELSE
123              CALL CHECK_SOLIDS_SPECIES(MMAX_L)
124           ENDIF
125     
126     ! Currently MMS uses constant properties. These are in place simply
127     ! to give the developer a heads-up that the code/setup may not fully
128     ! encompass the use of non-constant properties
129           IF (USE_MMS) THEN
130              DO M = 1, MMAX_L
131                 IF (MU_S0(M) == UNDEFINED) THEN
132                    WRITE(ERR_MSG, 1200) trim(ivar('MU_s0',M))
133                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
134                 ENDIF
135                 IF (K_S0(M) == UNDEFINED .AND. ENERGY_EQ) THEN
136                    WRITE(ERR_MSG, 1200) trim(ivar('K_s0',M))
137                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
138                 ENDIF
139                 IF (DIF_S0(M) == UNDEFINED .AND. SPECIES_EQ(M)) THEN
140                    WRITE(ERR_MSG, 1200) trim(ivar('DIF_S0',M))
141                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
142                 ENDIF
143              ENDDO
144      1200 FORMAT('Error 1200: ',A,' must be defined when USE_MMS is T.',/,&
145              'Please correct the mfix.dat file.')
146           ENDIF
147     
148     
149     ! Check solids drag model selection.
150           CALL CHECK_SOLIDS_DRAG
151     
152     ! Checks required for the subgrid drag models.
153           CALL CHECK_SUBGRID_MODEL
154     
155     ! Check the solids density input parameters.
156           CALL CHECK_SOLIDS_DENSITY(MMAX_L)
157     
158     ! Finalize the error messges
159           CALL FINL_ERR_MSG
160     
161           RETURN
162     
163      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
164              'correct the mfix.dat file.')
165     
166      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
167              'Please correct the mfix.dat file.')
168     
169      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.', &
170              'Please correct the mfix.dat file.')
171     
172           END SUBROUTINE CHECK_SOLIDS_COMMON_ALL
173     
174     
175     !----------------------------------------------------------------------!
176     ! Subroutine: CHECK_SOLIDS_DRAG                                        !
177     ! Purpose: Check solids species input.                                 !
178     !                                                                      !
179     ! Author: J. Musser                                  Date: 07-FEB-14   !
180     !----------------------------------------------------------------------!
181           SUBROUTINE CHECK_SOLIDS_DRAG
182     
183     ! Global Variables:
184     !---------------------------------------------------------------------//
185     ! User specifed drag type, as string and enum
186           use run, only: DRAG_TYPE
187           use run, only: DRAG_TYPE_ENUM
188     ! Possible DRAG_TYPE_ENUM values:
189           use run, only: SYAM_OBRIEN
190           use run, only: GIDASPOW
191           use run, only: GIDASPOW_PCF
192           use run, only: GIDASPOW_BLEND
193           use run, only: GIDASPOW_BLEND_PCF
194           use run, only: WEN_YU
195           use run, only: WEN_YU_PCF
196           use run, only: KOCH_HILL
197           use run, only: KOCH_HILL_PCF
198           use run, only: BVK
199           use run, only: HYS
200           use run, only: USER_DRAG
201     
202     ! Global Parameters:
203     !---------------------------------------------------------------------//
204     
205     ! Global Module procedures:
206     !---------------------------------------------------------------------//
207           use error_manager
208     
209           implicit none
210     
211     
212     ! Local Variables:
213     !---------------------------------------------------------------------//
214     !     NONE
215     
216     !......................................................................!
217     
218     
219     ! Initialize the error manager.
220           CALL INIT_ERR_MSG("CHECK_SOLIDS_DRAG")
221     
222           SELECT CASE(trim(adjustl(DRAG_TYPE)))
223     
224           CASE ('SYAM_OBRIEN'); DRAG_TYPE_ENUM = SYAM_OBRIEN
225           CASE ('GIDASPOW'); DRAG_TYPE_ENUM = GIDASPOW
226           CASE ('GIDASPOW_PCF'); DRAG_TYPE_ENUM = GIDASPOW_PCF
227           CASE ('GIDASPOW_BLEND'); DRAG_TYPE_ENUM = GIDASPOW_BLEND
228           CASE ('GIDASPOW_BLEND_PCF'); DRAG_TYPE_ENUM = GIDASPOW_BLEND_PCF
229           CASE ('WEN_YU'); DRAG_TYPE_ENUM = WEN_YU
230           CASE ('WEN_YU_PCF'); DRAG_TYPE_ENUM = WEN_YU_PCF
231           CASE ('KOCH_HILL'); DRAG_TYPE_ENUM = KOCH_HILL
232           CASE ('KOCH_HILL_PCF'); DRAG_TYPE_ENUM = KOCH_HILL_PCF
233           CASE ('BVK'); DRAG_TYPE_ENUM = BVK
234           CASE ('HYS'); DRAG_TYPE_ENUM = HYS
235           CASE ('USER_DRAG','USR_DRAG'); DRAG_TYPE_ENUM = USER_DRAG
236     
237           CASE DEFAULT
238              WRITE(ERR_MSG,1001)'DRAG_TYPE', trim(adjustl(DRAG_TYPE))
239              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
240           END SELECT
241     
242           CALL FINL_ERR_MSG
243     
244           RETURN
245     
246      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/   &
247              'Please correct the mfix.dat file.')
248     
249           END SUBROUTINE CHECK_SOLIDS_DRAG
250     
251     
252     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
253     !                                                                      !
254     !  Subroutine: CHECK_SUBGRID_MODEL                                     !
255     !  Purpose: Check the subgrid drag model interactions.                 !
256     !                                                                      !
257     !  Author: J.Musser                                   Date: 31-JAN-14  !
258     !                                                                      !
259     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
260           SUBROUTINE CHECK_SUBGRID_MODEL
261     
262     ! Global Variables:
263     !---------------------------------------------------------------------//
264     ! Flag: Specify friction model (Schaeffer model/Princeton model)
265           USE run, only: FRICTION
266     ! Flag: Solve granular energy eq
267           USE run, only: GRANULAR_ENERGY
268     ! Flag: Solve K-Epsilon Eq.
269           USE run, only: K_EPSILON
270     ! Flag: Impose a mean shear on flow field.
271           USE run, only: SHEAR
272     ! Flag: Invoke Schaeffer and KT-Theory blending
273           USE run, only: BLENDING_STRESS
274     ! User specifed drag model
275           USE run, only: DRAG_TYPE
276     ! Ratio of filter size to computational cell size
277           USE run, only: FILTER_SIZE_RATIO
278     ! User specifed subgrid model: IGCI or MILIOLI
279           USE run, only: SUBGRID_TYPE, SUBGRID_TYPE_ENUM
280           USE run, only: UNDEFINED_SUBGRID_TYPE, IGCI, MILIOLI
281     ! Flag: Include wall effect term
282           USE run, only: SUBGRID_WALL
283     ! Specularity coefficient for particle-wall collisions
284           use constant, only: PHIP
285     ! Flag: Use cartesian grid model
286           USE cutcell, only : CARTESIAN_GRID
287     ! Flag: Use discrete element solids model
288           use discretelement, only: DISCRETE_ELEMENT
289     ! Flag: Use MP-PIC solids model
290           use mfix_pic, only: MPPIC
291     
292     ! Global Parameters:
293     !---------------------------------------------------------------------//
294           USE param1, only: ZERO, UNDEFINED_C
295     
296     
297     ! Global Module procedures:
298     !---------------------------------------------------------------------//
299           USE error_manager
300     
301           IMPLICIT NONE
302     
303     ! Local Variables:
304     !---------------------------------------------------------------------//
305     ! NONE
306     
307     ! If the models are not being used, return.
308           IF(SUBGRID_TYPE == UNDEFINED_C .AND. .NOT.SUBGRID_WALL) RETURN
309     
310     
311     ! Initialize the error manager.
312           CALL INIT_ERR_MSG("CHECK_SUBGRID_MODEL")
313     
314     
315           IF(SUBGRID_TYPE == UNDEFINED_C .AND. SUBGRID_WALL) THEN
316              WRITE(ERR_MSG,2011)
317              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
318           ENDIF
319     
320      2011 FORMAT('Error 2011: Invalid input. SUBGRID_WALL cannot be used ',&
321               'without',/'specifying a SUBGRID_TYPE.',/'Please correct ',  &
322               'the mfix.dat file.')
323     
324     
325           SELECT CASE(trim(adjustl(SUBGRID_TYPE)))
326     
327           CASE ('IGCI'); SUBGRID_TYPE_ENUM = IGCI
328           CASE ('MILIOLI'); SUBGRID_TYPE_ENUM = MILIOLI
329           CASE DEFAULT
330              SUBGRID_TYPE_ENUM = UNDEFINED_SUBGRID_TYPE
331           END SELECT
332     
333           IF(SUBGRID_TYPE_ENUM .ne. IGCI .AND. SUBGRID_TYPE_ENUM .ne. MILIOLI) THEN
334              WRITE(ERR_MSG,1001) 'SUBGRID_TYPE', SUBGRID_TYPE
335              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
336           ENDIF
337     
338           IF(DRAG_TYPE /= 'WEN_YU')THEN
339              WRITE(ERR_MSG, 2012)
340              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
341           ENDIF
342     
343      2012 FORMAT('Error 2012: Invalid input. WEN_YU is the only DRAG_TYPE',&
344               ' available',/'when using the SUBGRID model.',/'Please ',    &
345               'correct the mfix.dat file.')
346     
347           IF(DISCRETE_ELEMENT .OR. MPPIC) THEN
348              WRITE(ERR_MSG, 2013)
349              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
350           ENDIF
351     
352      2013 FORMAT('Error 2013: Invalid input. The SUBGRID model is not ',    &
353               'available',/'with discrete solids phases.',/'Please ',      &
354               'correct the mfix.dat file.')
355     
356     ! Impose the subgrid limitations.
357           IF(FILTER_SIZE_RATIO <= ZERO) THEN
358              WRITE(ERR_MSG, 1002)'FILTER_SIZE_RATIO', FILTER_SIZE_RATIO
359              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
360     
361           ELSEIF(GRANULAR_ENERGY) THEN
362              WRITE(ERR_MSG, 2010) 'GRANULAR_ENERGY', 'FALSE'
363              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
364     
365           ELSEIF(K_EPSILON) THEN
366              WRITE(ERR_MSG, 2010) 'K_EPSILON', 'FALSE'
367              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
368     
369           ELSEIF(BLENDING_STRESS) THEN
370              WRITE(ERR_MSG, 2010) 'BLENDING_STRESS', 'FALSE'
371              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
372     
373           ELSEIF(FRICTION) THEN
374              WRITE(ERR_MSG, 2010) 'FRICTION', 'FALSE'
375              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
376     
377           ELSEIF(SHEAR) THEN
378              WRITE(ERR_MSG, 2010) 'SHEAR', 'FALSE'
379              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
380     
381           ELSEIF(PHIP /= ZERO) THEN
382              WRITE(ERR_MSG, 2010) 'PHIP', 'ZERO'
383              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
384     
385           ENDIF
386     
387           IF(SUBGRID_WALL .AND. .NOT.CARTESIAN_GRID) THEN
388              WRITE(ERR_MSG, 2010) 'CARTESIAN_GRID', 'TRUE'
389              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
390           ENDIF
391     
392      2010 FORMAT('Error 2010: Invalid input. ',A,' must be ',A,/'when ',    &
393              'using the SUBGRID model.'/,'Please correct the mfix.dat',    &
394              ' file.')
395     
396           CALL FINL_ERR_MSG
397     
398           RETURN
399     
400     
401      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/      &
402              'Please correct the mfix.dat file.')
403     
404      1002 FORMAT('Error 1002: Illegal or unknown input: ',A,' = ',G14.4,/  &
405              'Please correct the mfix.dat file.')
406     
407      1003 FORMAT('Error 1003: Illegal or unknown input: ',A,' = ',I4,/     &
408              'Please correct the mfix.dat file.')
409     
410           END SUBROUTINE CHECK_SUBGRID_MODEL
411     
412     
413     
414     !----------------------------------------------------------------------!
415     ! Subroutine: CHECK_SOLIDS_SPECIES                                     !
416     ! Purpose: Check solids species input.                                 !
417     !                                                                      !
418     ! Author: J. Musser                                  Date: 07-FEB-14   !
419     !----------------------------------------------------------------------!
420           SUBROUTINE CHECK_SOLIDS_SPECIES(MMAX_LL)
421     
422     
423     ! Global Variables:
424     !---------------------------------------------------------------------//
425     ! Flag: Solve energy equations
426           use run, only: ENERGY_EQ
427     ! Flag: Solve species equations
428           use run, only: SPECIES_EQ
429     ! FLag: Reinitializing the code
430           use run, only: REINITIALIZING
431     ! Flag: Database for phase X was read for species Y
432           use rxns, only: rDatabase
433     ! Solids phase species database names.
434           use rxns, only: SPECIES_s
435     ! Solids phase molecular weights.
436           use physprop, only: MW_s
437     ! Number of solids phase species.
438           use physprop, only: NMAX, NMAX_s
439     ! User specified: Constant solids specific heat
440           use physprop, only: C_PS0
441     
442     ! Global Parameters:
443     !---------------------------------------------------------------------//
444     ! Maximum number of solids phase species.
445           USE param, only: DIM_N_s
446     ! Parameter constants.
447           use param1, only: UNDEFINED, UNDEFINED_I, UNDEFINED_C
448     
449     ! Global Module procedures:
450     !---------------------------------------------------------------------//
451           use error_manager
452     
453     
454           implicit none
455     
456     
457     ! Subroutine Arguments:
458     !---------------------------------------------------------------------//
459     ! Total number of solids phases
460           INTEGER, intent(in) :: MMAX_LL
461     
462     ! Local Variables:
463     !---------------------------------------------------------------------//
464     
465     ! Flag that the energy equations are solved and specified solids phase
466     ! specific heat is undefined.
467     ! If true, a call to the thermochemical database is made.
468           LOGICAL EEQ_CPS
469     
470     ! Flag that the solids phase species equations are solved and the
471     ! molecular weight for a species are not given in the data file.
472     ! If true, a call to the thermochemical database is made.
473           LOGICAL SEQ_MWs
474     
475     ! Loop counters.
476           INTEGER :: M, N
477     
478     
479     !......................................................................!
480     
481     
482     ! Initialize the error manager.
483           CALL INIT_ERR_MSG("CHECK_SOLIDS_SPECIES")
484     
485     
486     ! Reconcile the new species input method with the legacy input method.
487           DO M=1, MMAX_LL
488              IF(SPECIES_EQ(M)) THEN
489                 IF(NMAX_s(M) == UNDEFINED_I) THEN
490                    WRITE(ERR_MSG,1000) iVar('NMAX_s',M)
491                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
492                 ELSEIF(NMAX_s(M) > DIM_N_S) THEN
493                    WRITE(ERR_MSG,1001) trim(iVar('NMAX_s',M)),            &
494                       trim(iVal(NMAX_s(M)))
495                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
496                 ELSE
497                    NMAX(M) = NMAX_s(M)
498                 ENDIF
499     
500     ! Set the number of species to one if the species equations are not solved and
501     ! the number of species is not specified.
502              ELSE
503                 NMAX(M) = merge(1, NMAX_s(M), NMAX_s(M) == UNDEFINED_I)
504              ENDIF
505     
506     ! Flag that the energy equations are solved and specified solids phase
507     ! specific heat is undefined.
508              EEQ_CPS = (ENERGY_EQ .AND. C_PS0(M) == UNDEFINED)
509              IF(EEQ_CPS .AND. .NOT.REINITIALIZING)THEN
510                 WRITE(ERR_MSG,2000)
511                 CALL FLUSH_ERR_MSG
512              ENDIF
513     
514      2000 FORMAT('Message: 2000 The energy equations are being solved ',   &
515              '(ENERGY_EQ) and',/'the constant solids specific heat is ',   &
516              'undefined (C_PS0). Thus, the',/'thermochemical database ',   &
517              'will be used to gather specific heat data on',/'the ',       &
518              'individual gas phase species.')
519     
520              SEQ_MWs = .FALSE.
521              DO N=1,NMAX(M)
522                 IF(MW_s(M,N) == UNDEFINED) THEN
523                    IF(SPECIES_EQ(M)) SEQ_MWs = .TRUE.
524                 ENDIF
525              ENDDO
526     
527              IF(SEQ_MWs .AND. .NOT.REINITIALIZING) THEN
528                 WRITE(ERR_MSG, 2001) M
529                 CALL FLUSH_ERR_MSG
530              ENDIF
531     
532      2001 FORMAT('Message 2001: One or more species molecular weights are',&
533              ' undefined and',/'the solids phase species equations are ',  &
534              'solved (SOLVE_EQ(',I2,')). The',/'thermochemical database ', &
535              'will be used in an attempt to gather missing',/'molecular ', &
536              'weight data.')
537     
538     ! Initialize flag indicating the database was read for a species.
539              rDatabase(M,:) = .FALSE.
540     
541              IF(EEQ_CPS .OR. SEQ_MWs)THEN
542     
543                 IF(.NOT.REINITIALIZING) THEN
544                    WRITE(ERR_MSG, 3000) M
545                    CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
546                 ENDIF
547     
548      3000 FORMAT('Message 3000: Searching thermochemical databases for ',  &
549              'solids phase',I3,/'species data.',/'  ')
550     
551                 DO N = 1, NMAX(M)
552     
553     ! Notify the user of the reason the thermochemical database is used.
554                    IF(EEQ_CPS .OR. MW_s(M,N) == UNDEFINED) THEN
555     
556     ! Flag that the species name is not provided.
557                       IF(SPECIES_s(M,N) == UNDEFINED_C) THEN
558                          WRITE(ERR_MSG,1000) trim(iVar('SPECIES_s',M,N))
559                          CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
560                       ENDIF
561     ! Update the log files.
562                       IF(.NOT.REINITIALIZING) THEN
563                          WRITE(ERR_MSG, 3001) N, trim(SPECIES_s(M,N))
564                          CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
565                       ENDIF
566                       3001 FORMAT(/2x,'>',I3,': Species: ',A)
567     
568                       CALL READ_DATABASE(M, N, SPECIES_s(M,N), MW_S(M,N))
569     ! Flag variable to stating that the database was read.
570                       rDatabase(M,N) = .TRUE.
571                    ENDIF
572                 ENDDO ! Loop over species
573                 IF(.NOT.REINITIALIZING) CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
574              ENDIF
575     
576     ! Verify that no additional species information was given.
577              DO N = NMAX(M) + 1, DIM_N_S
578                 IF(MW_S(M,N) /= UNDEFINED) THEN
579                    WRITE(ERR_MSG, 1002) trim(iVar('MW_s',M,N))
580                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
581                 ENDIF
582              ENDDO
583           ENDDO ! Loop over solids phases
584     
585           CALL FINL_ERR_MSG
586     
587           RETURN
588     
589      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
590              'correct the mfix.dat file.')
591     
592      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
593              'Please correct the mfix.dat file.')
594     
595      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
596              'Please correct the mfix.dat file.')
597     
598           END SUBROUTINE CHECK_SOLIDS_SPECIES
599     
600     
601     !----------------------------------------------------------------------!
602     ! Subroutine: CHECK_SOLIDS_SPECIES_LEGACY                              !
603     ! Purpose: These are legacy checks for using rrates.f to specify       !
604     ! chemical reactions.                                                  !
605     !                                                                      !
606     ! Author: J. Musser                                  Date: 03-FEB-14   !
607     !----------------------------------------------------------------------!
608           SUBROUTINE CHECK_SOLIDS_SPECIES_LEGACY(MMAX_LL)
609     
610     
611     ! Global Variables:
612     !---------------------------------------------------------------------//
613     ! Flag: Solve species equations
614           use run, only: SPECIES_EQ
615     ! Solids phase molecular weights.
616           use physprop, only: MW_s
617     ! Number of solids phase species.
618           use physprop, only: NMAX, NMAX_s
619     ! Flag: Database was read. (legacy)
620           use physprop, only: DATABASE_READ
621     
622     ! Global Parameters:
623     !---------------------------------------------------------------------//
624     ! Maximum number of gas phase species.
625           USE param, only: DIM_N_s
626     ! Constants.
627           USE param1, only: UNDEFINED_I, UNDEFINED
628     
629     ! Global Module procedures:
630     !---------------------------------------------------------------------//
631           use error_manager
632     
633     
634           implicit none
635     
636     
637     ! Arguments:
638     !---------------------------------------------------------------------//
639     ! Total number of solids phases
640           INTEGER, intent(in) :: MMAX_LL
641     
642     ! Local Variables:
643     !---------------------------------------------------------------------//
644     ! Loop counters.
645           INTEGER :: M, N
646     
647     
648     !......................................................................!
649     
650     
651     ! Initialize the error manager.
652           CALL INIT_ERR_MSG("CHECK_SOLIDS_SPECIES_LEGACY")
653     
654     ! Reconcile the new species input method with the legacy input method.
655           DO M=1, MMAX_LL
656              IF(SPECIES_EQ(M)) THEN
657     
658     ! Legacy checks for species equations.
659                 IF(NMAX_s(M) /= UNDEFINED_I) THEN
660                    WRITE(ERR_MSG,2000) trim(iVar('NMAX_s',M)), 'undefined'
661                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
662                 ELSEIF(NMAX(M) == UNDEFINED_I) THEN
663                    WRITE(ERR_MSG,2000) trim(iVar('NMAX',M)), 'specified'
664                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
665                 ELSEIF(NMAX(M) > DIM_N_S) THEN
666                    WRITE(ERR_MSG,1002) trim(iVar('NMAX',M))
667                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
668                 ENDIF
669     
670     ! Set the number of species to one if the species equations are not solved and
671     ! the number of species is not specified.
672              ELSE
673                 IF(NMAX(M) == UNDEFINED) NMAX(M) = 1
674              ENDIF
675           ENDDO
676     
677     ! Check MW_s if solids species are present
678           DO M = 1, MMAX_LL
679     ! Initialize flag indicating the database was read for a species.
680              DO N = 1, NMAX(M)
681                 IF(MW_S(M,N) == UNDEFINED) THEN
682                    WRITE(ERR_MSG, 2000) trim(iVar('MW_s',M,N)), 'specified'
683                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
684                 ENDIF
685              ENDDO ! Loop over species
686              DO N = NMAX(M) + 1, DIM_N_S
687                 IF(MW_S(M,N) /= UNDEFINED) THEN
688                    WRITE(ERR_MSG,1002) trim(iVar('MW_s',M,N))
689                 ENDIF
690              ENDDO
691           ENDDO ! Loop over solids phases
692     
693     ! Set the legacy database flag. (Also in check_gas_phase.f)
694           DATABASE_READ = .FALSE.
695     
696           CALL FINL_ERR_MSG
697     
698           RETURN
699     
700      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
701              'correct the mfix.dat file.')
702     
703      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
704              'Please correct the mfix.dat file.')
705     
706      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
707              'Please correct the mfix.dat file.')
708     
709      2000 FORMAT('Error 2000: Invalid input. ',A,' must be ',A,/'when ',   &
710              'USE_RRATES is .TRUE.'/,'Please correct the mfix.dat file')
711     
712           END SUBROUTINE CHECK_SOLIDS_SPECIES_LEGACY
713     
714     
715     
716     !----------------------------------------------------------------------!
717     !  Subroutine: CHECK_SOLIDS_DENSITY                                    !
718     !  Purpose: check the solid phase density input                        !
719     !                                                                      !
720     !  Author: J.Musser                                  Date: 03-FEB-14   !
721     !----------------------------------------------------------------------!
722           SUBROUTINE CHECK_SOLIDS_DENSITY(MMAX_LL)
723     
724     
725     ! Global Variables:
726     !---------------------------------------------------------------------//
727     ! Flag: Solve variable solids density.
728           use run, only: SOLVE_ROs
729     ! User specified: constant solids density
730           use physprop, only: RO_s0
731     ! Baseline species densities
732           use physprop, only: RO_Xs0
733     ! Baseline species mass fractions.
734           use physprop, only: X_s0
735     ! Index of inert solids species
736           use physprop, only: INERT_SPECIES
737     ! Inert species mass fraction in dilute region
738           use physprop, only: DIL_INERT_X_VSD
739     ! Number of solids phase species.
740           use physprop, only: NMAX
741     
742     ! Global Parameters:
743     !---------------------------------------------------------------------//
744     ! Parameter constants
745           use param1, only: ZERO, ONE
746           use param1, only: UNDEFINED, UNDEFINED_I
747     ! Maximum number of solids phases.
748           use param, only: DIM_M
749     ! Maximum number of solids species.
750           use param, only: DIM_N_s
751     
752     ! Solids phase density caMulation
753           use eos, ONLY: EOSS0
754     
755     ! Global Module procedures:
756     !---------------------------------------------------------------------//
757           use error_manager
758     
759     
760           implicit none
761     
762     
763     ! Arguments:
764     !---------------------------------------------------------------------//
765     ! Total number of solids phases
766           INTEGER, intent(in) :: MMAX_LL
767     
768     ! Local Variables:
769     !---------------------------------------------------------------------//
770           INTEGER :: M, N
771     
772     
773     !......................................................................!
774     
775     
776     ! Initialize the error manager.
777           CALL INIT_ERR_MSG("CHECK_SOLIDS_DENSITY")
778     
779     ! Initialize the flag for variable solids density.
780           SOLVE_ROs = .FALSE.
781     
782     ! Check each solids phase.
783           DO M = 1, MMAX_LL
784     
785     ! Set the flag for variable solids density if any of the input parameters
786     ! are specified.
787              IF(INERT_SPECIES(M) /= UNDEFINED_I) SOLVE_ROs(M) = .TRUE.
788              DO N=1, DIM_N_s
789                 IF(RO_Xs0(M,N) /= UNDEFINED) SOLVE_ROs(M) = .TRUE.
790                 IF(X_S0(M,N) /= UNDEFINED) SOLVE_ROs(M) = .TRUE.
791              ENDDO
792     
793     
794     ! Verify that one -and only one- solids density model is in use.
795              IF(RO_S0(M) == UNDEFINED .AND. .NOT.SOLVE_ROs(M)) THEN
796                 WRITE(ERR_MSG, 1100) M
797                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
798     
799      1100 FORMAT('Error 1101: No solids density information for phase ',  &
800              I2,'.',/'Please correct the mfix.dat file.')
801     
802     ! Check if the constant solids phase density is physical.
803              ELSEIF(RO_S0(M) /= UNDEFINED .AND. SOLVE_ROs(M)) THEN
804                 WRITE(ERR_MSG, 1101) M
805                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
806     
807      1101 FORMAT('Error 1101: Conflicting solids density input specified ',&
808              'for solids',/'phase ',I2,'. Constant solids density ',       &
809              'specified (RO_s0) along with one',/'or more of the variable',&
810              ' solids density parameters:',/'RO_Xs0, X_s0, INERT_SPECIES.',&
811              /'Please correct the mfix.dat file.')
812     
813              ENDIF
814     
815     ! Check physical restrictions on variable solids density input.
816              IF(SOLVE_ROs(M)) THEN
817     ! Check INERT_SPECIES
818                 IF(INERT_SPECIES(M) == UNDEFINED_I) THEN
819                    WRITE(ERR_MSG,1000) trim(iVar('INERT_SPECIES',M))
820                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
821                 ELSEIF(INERT_SPECIES(M) < 1 .OR.                          &
822                    INERT_SPECIES(M) > NMAX(M)) THEN
823                    WRITE(ERR_MSG, 1001) trim(iVar('INERT_SPECIES',M)),    &
824                       trim(iVal(INERT_SPECIES(M)))
825                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
826                 ENDIF
827                 IF(DIL_INERT_X_VSD(M)<=ZERO) THEN
828                    WRITE(ERR_MSG,1103) M, DIL_INERT_X_VSD(M)
829                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
830                 ELSEIF(DIL_INERT_X_VSD(M)>ONE) THEN
831                    WRITE(ERR_MSG,1104) M, DIL_INERT_X_VSD(M)
832                    print*,'M,DIL_INERT_X_VSD(M)=',M,DIL_INERT_X_VSD(M)
833                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
834                 ENDIF
835                 DO N=1, NMAX(M)
836     ! Check RO_Xs0
837                    IF(RO_Xs0(M,N) == UNDEFINED) THEN
838                       WRITE(ERR_MSG,1000) trim(iVar('RO_Xs0',M,N))
839                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
840                    ELSEIF(RO_Xs0(M,N) < ZERO) THEN
841                       WRITE(ERR_MSG,1001) trim(iVar('RO_Xs0',M,N)),        &
842                          trim(iVal(RO_xs0(M,N)))
843                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
844                    ENDIF
845     ! Check X_s0
846                    IF(X_s0(M,N) == UNDEFINED) THEN
847                       WRITE(ERR_MSG,1000) trim(iVar('X_s0',M,N))
848                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
849                    ELSEIF(X_s0(M,N) < ZERO .OR. X_s0(M,N) >= ONE) THEN
850                       WRITE(ERR_MSG,1001) trim(iVar('X_s0',M,N)),        &
851                          trim(iVal(X_s0(M,N)))
852                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
853                    ENDIF
854                 ENDDO
855     
856     ! Check for input overflow.
857                 DO N=NMAX(M)+1, DIM_N_s
858                    IF(RO_Xs0(M,N) /= UNDEFINED) THEN
859                       WRITE(ERR_MSG,1002) trim(iVar('RO_Xs0',M,N))
860                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
861                    ENDIF
862                    IF(X_s0(M,N) /= UNDEFINED) THEN
863                       WRITE(ERR_MSG,1002) trim(iVar('X_s0',M,N))
864                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
865                    ENDIF
866                 ENDDO
867     
868     ! Check X_s0(Inert)
869                 IF(X_s0(M,INERT_SPECIES(M)) == ZERO) THEN
870                    WRITE(ERR_MSG,1102) M, INERT_SPECIES(M)
871                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
872                 ENDIF
873     
874      1102 FORMAT('Error 1102: Invalid baseline inert species mass',/       &
875              'fraction. The inert species mass fraction must be greater ',  &
876              'than zero.',/' Phase ',I2,' Inert Species: ',I3,' X_s0 = 0.0')
877     
878      1103 FORMAT('Error 1103: Invalid dilute region inert species mass',/   &
879              'fraction. The inert species mass fraction must be greater ',  &
880              'than zero.',/' Phase ',I2,/ &
881              ' Please check the value of DIL_INERT_X_VSD:',G14.4)
882     
883      1104 FORMAT('Error 1104: Invalid dilute region inert species mass',/   &
884              'fraction. The inert species mass fraction must be less ',  &
885              'than or equal to one.',/' Phase ',I2,/ &
886              ' Please check the value of DIL_INERT_X_VSD:',G14.4)
887     
888     ! All of the information for variable solids density has been verified
889     ! as of this point. Calculate and store the baseline density.
890                 RO_s0(M) = EOSS0(M)
891     
892     ! Check physical restrictions on constant solids density input.
893              ELSEIF(RO_S0(M) <= ZERO) THEN
894                 WRITE(ERR_MSG,1101) iVar('RO_s0',M), iVal(RO_s0(M))
895                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
896              ENDIF
897     
898           ENDDO
899     
900     ! Check for input overflow.
901           DO M = MMAX_LL+1, DIM_M
902              IF(RO_S0(M) /= UNDEFINED) THEN
903                 WRITE(ERR_MSG,1002) trim(iVar('RO_s0',M))
904                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
905              ENDIF
906              IF(INERT_SPECIES(M) /= UNDEFINED_I) THEN
907                 WRITE(ERR_MSG,1002) trim(iVar('INERT_SPECIES',M))
908                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
909              ENDIF
910              DO N=1, DIM_N_s
911                 IF(RO_Xs0(M,N) /= UNDEFINED) THEN
912                    WRITE(ERR_MSG,1002) trim(iVar('RO_Xs0',M,N))
913                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
914                 ENDIF
915                 IF(X_s0(M,N) /= UNDEFINED) THEN
916                    WRITE(ERR_MSG,1002) trim(iVar('X_s0',M,N))
917                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
918                 ENDIF
919              ENDDO
920           ENDDO
921     
922     ! Finalize the error messges
923           CALL FINL_ERR_MSG
924     
925           RETURN
926     
927      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
928                 'correct the mfix.dat file.')
929     
930      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
931              'Please correct the mfix.dat file.')
932     
933      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
934              'Please correct the mfix.dat file.')
935     
936           END SUBROUTINE CHECK_SOLIDS_DENSITY
937