File: /nfs/home/0/users/jenkins/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 disctete (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     ! Flag: Solve energy equations
161           use run, only: ENERGY_EQ
162     ! Flag: Solve species equations
163           use run, only: SPECIES_EQ
164     ! User specifed drag type, as string and enum
165           use run, only: DRAG_TYPE
166           use run, only: DRAG_TYPE_ENUM
167     ! Possible DRAG_TYPE_ENUM values:
168           use run, only: SYAM_OBRIEN
169           use run, only: GIDASPOW
170           use run, only: GIDASPOW_PCF
171           use run, only: GIDASPOW_BLEND
172           use run, only: GIDASPOW_BLEND_PCF
173           use run, only: WEN_YU
174           use run, only: WEN_YU_PCF
175           use run, only: KOCH_HILL
176           use run, only: KOCH_HILL_PCF
177           use run, only: BVK
178           use run, only: HYS
179           use run, only: USER_DRAG
180     
181     ! Global Parameters:
182     !---------------------------------------------------------------------//
183     ! Parameter constants.
184           use param1, only: UNDEFINED, UNDEFINED_I, UNDEFINED_C
185     
186     ! Global Module procedures:
187     !---------------------------------------------------------------------//
188           use error_manager
189     
190           implicit none
191     
192     
193     ! Local Variables:
194     !---------------------------------------------------------------------//
195     !     NONE
196     
197     !......................................................................!
198     
199     
200     ! Initialize the error manager.
201           CALL INIT_ERR_MSG("CHECK_SOLIDS_DRAG")
202     
203           SELECT CASE(trim(adjustl(DRAG_TYPE)))
204     
205           CASE ('SYAM_OBRIEN'); DRAG_TYPE_ENUM = SYAM_OBRIEN
206           CASE ('GIDASPOW'); DRAG_TYPE_ENUM = GIDASPOW
207           CASE ('GIDASPOW_PCF'); DRAG_TYPE_ENUM = GIDASPOW_PCF
208           CASE ('GIDASPOW_BLEND'); DRAG_TYPE_ENUM = GIDASPOW_BLEND
209           CASE ('GIDASPOW_BLEND_PCF'); DRAG_TYPE_ENUM = GIDASPOW_BLEND_PCF
210           CASE ('WEN_YU'); DRAG_TYPE_ENUM = WEN_YU
211           CASE ('WEN_YU_PCF'); DRAG_TYPE_ENUM = WEN_YU_PCF
212           CASE ('KOCH_HILL'); DRAG_TYPE_ENUM = KOCH_HILL
213           CASE ('KOCH_HILL_PCF'); DRAG_TYPE_ENUM = KOCH_HILL_PCF
214           CASE ('BVK'); DRAG_TYPE_ENUM = BVK
215           CASE ('HYS'); DRAG_TYPE_ENUM = HYS
216           CASE ('USER_DRAG','USR_DRAG'); DRAG_TYPE_ENUM = USER_DRAG
217     
218           CASE DEFAULT
219              WRITE(ERR_MSG,1001)'DRAG_TYPE', trim(adjustl(DRAG_TYPE))
220              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
221           END SELECT
222     
223           CALL FINL_ERR_MSG
224     
225           RETURN
226     
227      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/   &
228              'Please correct the mfix.dat file.')
229     
230           END SUBROUTINE CHECK_SOLIDS_DRAG
231     
232     
233     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
234     !                                                                      !
235     !  Subroutine: CHECK_SUBGRID_MODEL                                     !
236     !  Purpose: Check the subgrid drag model interactions.                 !
237     !                                                                      !
238     !  Author: J.Musser                                   Date: 31-JAN-14  !
239     !                                                                      !
240     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
241           SUBROUTINE CHECK_SUBGRID_MODEL
242     
243     ! Global Variables:
244     !---------------------------------------------------------------------//
245     ! Flag: Specify friction model (Schaeffer model/Princeton model)
246           USE run, only: FRICTION
247     ! Flag: Solve granular energy eq
248           USE run, only: GRANULAR_ENERGY
249     ! Flag: SOlve K-Epsilong Eq.
250           USE run, only: K_EPSILON
251     ! Flag: Impose a mean shear on flow field.
252           USE run, only: SHEAR
253     ! Flag: Invoke Schaeffer and KT-Theory blending
254           USE run, only: BLENDING_STRESS
255     ! User specifed drag model
256           USE run, only: DRAG_TYPE
257     ! Ratio of filter size to computational cell size
258           USE run, only: FILTER_SIZE_RATIO
259     ! User specifed subgrid model: IGCI or MILIOLI
260           USE run, only: SUBGRID_TYPE, SUBGRID_TYPE_ENUM, UNDEFINED_SUBGRID_TYPE, IGCI, MILIOLI
261     ! Flag: Include wall effect term
262           USE run, only: SUBGRID_WALL
263     ! Initial turbulcence length scale
264           use constant, only: L_SCALE0
265     ! Specularity coefficient for particle-wall collisions
266           use constant, only: PHIP
267     ! Flag: Use cartesian grid model
268           USE cutcell, only : CARTESIAN_GRID
269     ! Flag: Use discrete element solids model
270           use discretelement, only: DISCRETE_ELEMENT
271     ! Flag: Use MP-PIC solids model
272           use mfix_pic, only: MPPIC
273     
274     ! Global Parameters:
275     !---------------------------------------------------------------------//
276           USE param1, only: ZERO, UNDEFINED_C
277     
278     
279     ! Global Module procedures:
280     !---------------------------------------------------------------------//
281           USE error_manager
282     
283           IMPLICIT NONE
284     
285     ! Local Variables:
286     !---------------------------------------------------------------------//
287     ! NONE
288     
289     ! If the modles are not being used, return.
290           IF(SUBGRID_TYPE == UNDEFINED_C .AND. .NOT.SUBGRID_WALL) RETURN
291     
292     
293     ! Initialize the error manager.
294           CALL INIT_ERR_MSG("CHECK_SUBGRID_MODEL")
295     
296     
297           IF(SUBGRID_TYPE == UNDEFINED_C .AND. SUBGRID_WALL) THEN
298              WRITE(ERR_MSG,2011)
299              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
300           ENDIF
301     
302      2011 FORMAT('Error 2011: Invalid input. SUBGRID_WALL cannot be used ',&
303               'without',/'specifying a SUBGRID_TYPE.',/'Please correct ',  &
304               'the mfix.dat file.')
305     
306     
307           SELECT CASE(trim(adjustl(SUBGRID_TYPE)))
308     
309           CASE ('IGCI'); SUBGRID_TYPE_ENUM = IGCI
310           CASE ('MILIOLI'); SUBGRID_TYPE_ENUM = MILIOLI
311           CASE DEFAULT
312              SUBGRID_TYPE_ENUM = UNDEFINED_SUBGRID_TYPE
313           END SELECT
314     
315           IF(SUBGRID_TYPE_ENUM .ne. IGCI .AND. SUBGRID_TYPE_ENUM .ne. MILIOLI) THEN
316              WRITE(ERR_MSG,1001) 'SUBGRID_TYPE', SUBGRID_TYPE
317              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
318           ENDIF
319     
320           IF(DRAG_TYPE /= 'WEN_YU')THEN
321              WRITE(ERR_MSG, 2012)
322              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
323           ENDIF
324     
325      2012 FORMAT('Error 2012: Invalid input. WEN_YU is the only DRAG_TYPE',&
326               ' available',/'when using the SUBGRID model.',/'Please ',    &
327               'correct the mfix.dat file.')
328     
329           IF(DISCRETE_ELEMENT .OR. MPPIC) THEN
330              WRITE(ERR_MSG, 2013)
331              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
332           ENDIF
333     
334      2013 FORMAT('Error 2013: Invalid input. The SUBRID model is not ',    &
335               'available',/'with discrete solids phases.',/'Please ',      &
336               'correct the mfix.dat file.')
337     
338     ! Impose the subgrid limitations.
339           IF(FILTER_SIZE_RATIO <= ZERO) THEN
340              WRITE(ERR_MSG, 1002)'FILTER_SIZE_RATIO', FILTER_SIZE_RATIO
341              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
342     
343           ELSEIF(GRANULAR_ENERGY) THEN
344              WRITE(ERR_MSG, 2010) 'GRANULAR_ENERGY', 'FALSE'
345              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
346     
347           ELSEIF(K_EPSILON) THEN
348              WRITE(ERR_MSG, 2010) 'K_EPSILON', 'FALSE'
349              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
350     
351           ELSEIF(BLENDING_STRESS) THEN
352              WRITE(ERR_MSG, 2010) 'BLENDING_STRESS', 'FALSE'
353              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
354     
355           ELSEIF(FRICTION) THEN
356              WRITE(ERR_MSG, 2010) 'FRICTION', 'FALSE'
357              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
358     
359           ELSEIF(SHEAR) THEN
360              WRITE(ERR_MSG, 2010) 'SHEAR', 'FALSE'
361              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
362     
363           ELSEIF(PHIP /= ZERO) THEN
364              WRITE(ERR_MSG, 2010) 'PHIP', 'ZERO'
365              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
366     
367           ENDIF
368     
369           IF(SUBGRID_WALL .AND. .NOT.CARTESIAN_GRID) THEN
370              WRITE(ERR_MSG, 2010) 'CARTESIAN_GRID', 'TRUE'
371              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
372           ENDIF
373     
374      2010 FORMAT('Error 2010: Invalid input. ',A,' must be ',A,/'when ',    &
375              'using the SUBGRID model.'/,'Please correct the mfix.dat',    &
376              ' file.')
377     
378           CALL FINL_ERR_MSG
379     
380           RETURN
381     
382     
383      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/      &
384              'Please correct the mfix.dat file.')
385     
386      1002 FORMAT('Error 1002: Illegal or unknown input: ',A,' = ',G14.4,/  &
387              'Please correct the mfix.dat file.')
388     
389      1003 FORMAT('Error 1003: Illegal or unknown input: ',A,' = ',I4,/     &
390              'Please correct the mfix.dat file.')
391     
392           END SUBROUTINE CHECK_SUBGRID_MODEL
393     
394     
395     
396     !----------------------------------------------------------------------!
397     ! Subroutine: CHECK_SOLIDS_SPECIES                                     !
398     ! Purpose: Check solids species input.                                 !
399     !                                                                      !
400     ! Author: J. Musser                                  Date: 07-FEB-14   !
401     !----------------------------------------------------------------------!
402           SUBROUTINE CHECK_SOLIDS_SPECIES(MMAX_LL)
403     
404     
405     ! Global Variables:
406     !---------------------------------------------------------------------//
407     ! Flag: Solve energy equations
408           use run, only: ENERGY_EQ
409     ! Flag: Solve species equations
410           use run, only: SPECIES_EQ
411     
412     ! Flag: Database for phase X was read for species Y
413           use rxns, only: rDatabase
414     ! Solids phase species database names.
415           use rxns, only: SPECIES_s
416     ! Solids phase molecular weights.
417           use physprop, only: MW_s
418     ! Number of solids phase species.
419           use physprop, only: NMAX, NMAX_s
420     ! User specified: Constant solids specific heat
421           use physprop, only: C_PS0
422     
423     ! Global Parameters:
424     !---------------------------------------------------------------------//
425     ! Maximum number of solids phase species.
426           USE param, only: DIM_N_s
427     ! Parameter constants.
428           use param1, only: UNDEFINED, UNDEFINED_I, UNDEFINED_C
429     
430     ! Global Module procedures:
431     !---------------------------------------------------------------------//
432           use error_manager
433     
434     
435           implicit none
436     
437     
438     ! Subroutine Arguments:
439     !---------------------------------------------------------------------//
440     ! Total number of solids phases
441           INTEGER, intent(in) :: MMAX_LL
442     
443     ! Local Variables:
444     !---------------------------------------------------------------------//
445     
446     ! Flag that the energy equations are solved and specified solids phase
447     ! specific heat is undefined.
448     ! If true, a call to the thermochemical database is made.
449           LOGICAL EEQ_CPS
450     
451     ! Flag that the solids phase species equations are solved and the
452     ! molecular weight for a species are not given in the data file.
453     ! If true, a call to the thermochemical database is made.
454           LOGICAL SEQ_MWs
455     
456     ! Loop counters.
457           INTEGER :: M, N
458     
459     
460     !......................................................................!
461     
462     
463     ! Initialize the error manager.
464           CALL INIT_ERR_MSG("CHECK_SOLIDS_SPECIES")
465     
466     
467     ! Reconcile the new species input method with the legacy input method.
468           DO M=1, MMAX_LL
469              IF(SPECIES_EQ(M)) THEN
470                 IF(NMAX_s(M) == UNDEFINED_I) THEN
471                    WRITE(ERR_MSG,1000) iVar('NMAX_s',M)
472                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
473                 ELSEIF(NMAX_s(M) > DIM_N_S) THEN
474                    WRITE(ERR_MSG,1001) trim(iVar('NMAX_s',M)),            &
475                       trim(iVal(NMAX_s(M)))
476                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
477                 ELSE
478                    NMAX(M) = NMAX_s(M)
479                 ENDIF
480     
481     ! Set the number of species to one if the species equations are not solved and
482     ! the number of species is not specified.
483              ELSE
484                 NMAX(M) = merge(1, NMAX_s(M), NMAX_s(M) == UNDEFINED_I)
485              ENDIF
486     
487     ! Flag that the energy equations are solved and specified solids phase
488     ! specific heat is undefined.
489              EEQ_CPS = (ENERGY_EQ .AND. C_PS0(M) == UNDEFINED)
490              IF(EEQ_CPS)THEN
491                 WRITE(ERR_MSG,2000)
492                 CALL FLUSH_ERR_MSG
493              ENDIF
494     
495      2000 FORMAT('Message: 2000 The energy equations are being solved ',   &
496              '(ENERGY_EQ) and',/'the constant solids specific heat is ',   &
497              'undefined (C_PS0). Thus, the',/'thermochemical database ',   &
498              'will be used to gather specific heat data on',/'the ',       &
499              'individual gas phase species.')
500     
501              SEQ_MWs = .FALSE.
502              DO N=1,NMAX(M)
503                 IF(MW_s(M,N) == UNDEFINED) THEN
504                    IF(SPECIES_EQ(M)) SEQ_MWs = .TRUE.
505                 ENDIF
506              ENDDO
507     
508              IF(SEQ_MWs) THEN
509                 WRITE(ERR_MSG, 2001) M
510                 CALL FLUSH_ERR_MSG
511              ENDIF
512     
513      2001 FORMAT('Message 2001: One or more species molecular weights are',&
514              ' undefined and',/'the solids phase species equations are ',  &
515              'solved (SOLVE_EQ(',I2,')). The',/'thermochemical database ', &
516              'will be used in an attempt to gather missing',/'molecular ', &
517              'weight data.')
518     
519     ! Initialize flag indicating the database was read for a species.
520              rDatabase(M,:) = .FALSE.
521     
522              IF(EEQ_CPS .OR. SEQ_MWs) THEN
523     
524                 WRITE(ERR_MSG, 3000) M
525                 CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
526     
527      3000 FORMAT('Message 3000: Searching thermochemical databases for ',  &
528              'solids phase',I3,/'species data.',/'  ')
529     
530                 DO N = 1, NMAX(M)
531     
532     ! Notify the user of the reason the thermochemical database is used.
533                    IF(EEQ_CPS .OR. MW_s(M,N) == UNDEFINED) THEN
534     
535     ! Flag that the species name is not provided.
536                       IF(SPECIES_s(M,N) == UNDEFINED_C) THEN
537                          WRITE(ERR_MSG,1000) trim(iVar('SPECIES_s',M,N))
538                          CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
539                       ENDIF
540     ! Update the log files.
541                       WRITE(ERR_MSG, 3001) N, trim(SPECIES_s(M,N))
542                       CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
543                       3001 FORMAT(/2x,'>',I3,': Species: ',A)
544     
545                       CALL READ_DATABASE(M, N, SPECIES_s(M,N), MW_S(M,N))
546     ! Flag variable to stating that the database was read.
547                       rDatabase(M,N) = .TRUE.
548                    ENDIF
549                 ENDDO ! Loop over species
550                 CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
551              ENDIF
552     
553     ! Verify that no additional species information was given.
554              DO N = NMAX(M) + 1, DIM_N_S
555                 IF(MW_S(M,N) /= UNDEFINED) THEN
556                    WRITE(ERR_MSG, 1002) trim(iVar('MW_s',M,N))
557                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
558                 ENDIF
559              ENDDO
560           ENDDO ! Loop over solids phases
561     
562           CALL FINL_ERR_MSG
563     
564           RETURN
565     
566      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
567              'correct the mfix.dat file.')
568     
569      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
570              'Please correct the mfix.dat file.')
571     
572      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
573              'Please correct the mfix.dat file.')
574     
575           END SUBROUTINE CHECK_SOLIDS_SPECIES
576     
577     
578     !----------------------------------------------------------------------!
579     ! Subroutine: CHECK_SOLIDS_SPECIES_LEGACY                              !
580     ! Purpose: These are legacy checks for using rrates.f to specify       !
581     ! chemcial reactions.                                                  !
582     !                                                                      !
583     ! Author: J. Musser                                  Date: 03-FEB-14   !
584     !----------------------------------------------------------------------!
585           SUBROUTINE CHECK_SOLIDS_SPECIES_LEGACY(MMAX_LL)
586     
587     
588     ! Global Variables:
589     !---------------------------------------------------------------------//
590     ! Flag: Solve species equations
591           use run, only: SPECIES_EQ
592     ! Solids phase molecular weights.
593           use physprop, only: MW_s
594     ! Number of solids phase species.
595           use physprop, only: NMAX, NMAX_s
596     ! Flag: Database was read. (legacy)
597           use physprop, only: DATABASE_READ
598     
599     ! Global Parameters:
600     !---------------------------------------------------------------------//
601     ! Maximum number of gas phase species.
602           USE param, only: DIM_N_s
603     ! Constants.
604           USE param1, only: UNDEFINED_I, UNDEFINED, ZERO
605     
606     ! Global Module procedures:
607     !---------------------------------------------------------------------//
608           use error_manager
609     
610     
611           implicit none
612     
613     
614     ! Arguments:
615     !---------------------------------------------------------------------//
616     ! Total number of solids phases
617           INTEGER, intent(in) :: MMAX_LL
618     
619     ! Local Variables:
620     !---------------------------------------------------------------------//
621     ! Loop counters.
622           INTEGER :: M, N
623     
624     
625     !......................................................................!
626     
627     
628     ! Initialize the error manager.
629           CALL INIT_ERR_MSG("CHECK_SOLIDS_SPECIES_LEGACY")
630     
631     ! Reconcile the new species input method with the legacy input method.
632           DO M=1, MMAX_LL
633              IF(SPECIES_EQ(M)) THEN
634     
635     ! Legacy checks for species equations.
636                 IF(NMAX_s(M) /= UNDEFINED_I) THEN
637                    WRITE(ERR_MSG,2000) trim(iVar('NMAX_s',M)), 'undefined'
638                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
639                 ELSEIF(NMAX(M) == UNDEFINED_I) THEN
640                    WRITE(ERR_MSG,2000) trim(iVar('NMAX',M)), 'specified'
641                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
642                 ELSEIF(NMAX(M) > DIM_N_S) THEN
643                    WRITE(ERR_MSG,1002) trim(iVar('NMAX',M))
644                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
645                 ENDIF
646     
647     ! Set the number of species to one if the species equations are not solved and
648     ! the number of species is not specified.
649              ELSE
650                 IF(NMAX(M) == UNDEFINED) NMAX(M) = 1
651              ENDIF
652           ENDDO
653     
654     ! Check MW_s if solids species are present
655           DO M = 1, MMAX_LL
656     ! Initialize flag indicating the database was read for a species.
657              DO N = 1, NMAX(M)
658                 IF(MW_S(M,N) == UNDEFINED) THEN
659                    WRITE(ERR_MSG, 2000) trim(iVar('MW_s',M,N)), 'specified'
660                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
661                 ENDIF
662              ENDDO ! Loop over species
663              DO N = NMAX(M) + 1, DIM_N_S
664                 IF(MW_S(M,N) /= UNDEFINED) THEN
665                    WRITE(ERR_MSG,1002) trim(iVar('MW_s',M,N))
666                 ENDIF
667              ENDDO
668           ENDDO ! Loop over solids phases
669     
670     ! Set the legacy database flag. (Also in check_gas_phase.f)
671           DATABASE_READ = .FALSE.
672     
673           CALL FINL_ERR_MSG
674     
675           RETURN
676     
677      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
678              'correct the mfix.dat file.')
679     
680      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
681              'Please correct the mfix.dat file.')
682     
683      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
684              'Please correct the mfix.dat file.')
685     
686      2000 FORMAT('Error 2000: Invalid input. ',A,' must be ',A,/'when ',   &
687              'USE_RRATES is .TRUE.'/,'Please correct the mfix.dat file')
688     
689           END SUBROUTINE CHECK_SOLIDS_SPECIES_LEGACY
690     
691     
692     
693     !----------------------------------------------------------------------!
694     !  Subroutine: CHECK_SOLIDS_DENSITY                                    !
695     !  Purpose: check the solid phase density input                        !
696     !                                                                      !
697     !  Author: J.Musser                                  Date: 03-FEB-14   !
698     !----------------------------------------------------------------------!
699           SUBROUTINE CHECK_SOLIDS_DENSITY(MMAX_LL)
700     
701     
702     ! Global Variables:
703     !---------------------------------------------------------------------//
704     ! Flag: Solve variable solids density.
705           use run, only: SOLVE_ROs
706     ! User specified: constant solids density
707           use physprop, only: RO_s0
708     ! Calculated baseline variable solids density.
709           use physprop, only: BASE_ROs
710     ! Baseline species densities
711           use physprop, only: RO_Xs0
712     ! Baseline species mass fractions.
713           use physprop, only: X_s0
714     ! Index of inert solids species
715           use physprop, only: INERT_SPECIES
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                 DO N=1, NMAX(M)
805     ! Check RO_Xs0
806                    IF(RO_Xs0(M,N) == UNDEFINED) THEN
807                       WRITE(ERR_MSG,1000) trim(iVar('RO_Xs0',M,N))
808                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
809                    ELSEIF(RO_Xs0(M,N) < ZERO) THEN
810                       WRITE(ERR_MSG,1001) trim(iVar('RO_Xs0',M,N)),        &
811                          trim(iVal(RO_xs0(M,N)))
812                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
813                    ENDIF
814     ! Check X_s0
815                    IF(X_s0(M,N) == UNDEFINED) THEN
816                       WRITE(ERR_MSG,1000) trim(iVar('X_s0',M,N))
817                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
818                    ELSEIF(X_s0(M,N) < ZERO .OR. X_s0(M,N) >= ONE) THEN
819                       WRITE(ERR_MSG,1001) trim(iVar('X_s0',M,N)),        &
820                          trim(iVal(X_s0(M,N)))
821                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
822                    ENDIF
823                 ENDDO
824     
825     ! Check for input overflow.
826                 DO N=NMAX(M)+1, DIM_N_s
827                    IF(RO_Xs0(M,N) /= UNDEFINED) THEN
828                       WRITE(ERR_MSG,1002) trim(iVar('RO_Xs0',M,N))
829                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
830                    ENDIF
831                    IF(X_s0(M,N) /= UNDEFINED) THEN
832                       WRITE(ERR_MSG,1002) trim(iVar('X_s0',M,N))
833                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
834                    ENDIF
835                 ENDDO
836     
837     ! Check X_s0(Inert)
838                 IF(X_s0(M,INERT_SPECIES(M)) == ZERO) THEN
839                    WRITE(ERR_MSG,1102) M, INERT_SPECIES(M)
840                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
841                 ENDIF
842     
843      1102 FORMAT('Error 1102: Invalid baseline inert speices mass',/       &
844              'fraction. The inert spcies mass fraction must be greater ',  &
845              'than zero.',/' Phase ',I2,' Inert Species: ',I3,' X_s0 = 0.0')
846     
847     ! All of the information for variable solids density has been verified
848     ! as of this point. Calculate and store the baseline density.
849                 BASE_ROs(M) = EOSS0(M)
850     
851     ! Check physical restrictions on constant solids density input.
852              ELSEIF(RO_S0(M) <= ZERO) THEN
853                 WRITE(ERR_MSG,1101) iVar('RO_s0',M), iVal(RO_s0(M))
854                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
855              ENDIF
856     
857           ENDDO
858     
859     ! Check for input overflow.
860           DO M = MMAX_LL+1, DIM_M
861              IF(RO_S0(M) /= UNDEFINED) THEN
862                 WRITE(ERR_MSG,1002) trim(iVar('RO_s0',M))
863                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
864              ENDIF
865              IF(INERT_SPECIES(M) /= UNDEFINED_I) THEN
866                 WRITE(ERR_MSG,1002) trim(iVar('INERT_SPECIES',M))
867                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
868              ENDIF
869              DO N=1, DIM_N_s
870                 IF(RO_Xs0(M,N) /= UNDEFINED) THEN
871                    WRITE(ERR_MSG,1002) trim(iVar('RO_Xs0',M,N))
872                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
873                 ENDIF
874                 IF(X_s0(M,N) /= UNDEFINED) THEN
875                    WRITE(ERR_MSG,1002) trim(iVar('X_s0',M,N))
876                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
877                 ENDIF
878              ENDDO
879           ENDDO
880     
881     ! Finalize the error messges
882           CALL FINL_ERR_MSG
883     
884           RETURN
885     
886      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
887                 'correct the mfix.dat file.')
888     
889      1001 FORMAT('Error 1001: Illegal or unphysical input: ',A,' = ',A,/   &
890              'Please correct the mfix.dat file.')
891     
892      1002 FORMAT('Error 1002: Illegal input: ',A,' specified out of range.',&
893              'Please correct the mfix.dat file.')
894     
895           END SUBROUTINE CHECK_SOLIDS_DENSITY
896