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