File: /nfs/home/0/users/jenkins/mfix.git/model/check_data/check_point_sources.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  SUBROUTINE: CHECK_POINT_SOURCES                                     !
4     !  Author: J. Musser                                  Date: 10-JUN-13  !
5     !                                                                      !
6     !  Purpose: Check point source specifications.                         !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE CHECK_POINT_SOURCES
10     
11     ! Global Variables:
12     !---------------------------------------------------------------------//
13     ! Flag: PS geometry was detected.
14           use ps, only: PS_DEFINED
15     
16     ! Global Parameters:
17     !---------------------------------------------------------------------//
18     ! Maximum number of PS.
19           use param, only: DIMENSION_PS
20     
21     ! Use the error manager for posting error messages.
22     !---------------------------------------------------------------------//
23           use error_manager
24     
25           implicit none
26     
27     ! Local Variables:
28     !---------------------------------------------------------------------//
29     ! Loop counter for BCs
30           INTEGER :: PSV
31     !......................................................................!
32     
33     
34     ! Initialize the error manager.
35           CALL INIT_ERR_MSG("CHECK_POINT_SOURCES")
36     
37     ! Determine which PSs are DEFINED
38           CALL CHECK_PS_GEOMETRY
39     
40     ! Loop over all PS arrays.
41           DO PSV = 1, DIMENSION_PS
42     
43     ! Verify user input for defined defined PS.
44              IF(PS_DEFINED(PSV)) THEN
45                 CALL GET_PS(PSV)
46                 CALL CHECK_PS_GAS_PHASE(PSV)
47                 CALL CHECK_PS_SOLIDS_PHASES(PSV)
48              ELSE
49     ! Verify that no data was defined for unspecified PS.
50                 CALL CHECK_PS_OVERFLOW(PSV)
51              ENDIF
52           ENDDO
53     
54     ! Clear the error manager.
55           CALL FINL_ERR_MSG
56     
57           RETURN
58           END SUBROUTINE CHECK_POINT_SOURCES
59     
60     
61     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
62     !                                                                      !
63     !  SUBROUTINE: CHECK_PS_GEOMETRY                                       !
64     !  Author: J. Musser                                  Date: 10-JUN-13  !
65     !                                                                      !
66     !  Purpose: Check point source specifications.                         !
67     !                                                                      !
68     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
69           SUBROUTINE CHECK_PS_GEOMETRY
70     
71     
72     ! Global Variables:
73     !---------------------------------------------------------------------//
74     ! Flag: PS contains geometric data and/or specified type
75           use ps, only: PS_DEFINED, POINT_SOURCE
76     ! User specifed: PS geometry
77           use ps, only: PS_X_e, PS_X_w, PS_I_e, PS_I_w
78           use ps, only: PS_Y_n, PS_Y_s, PS_J_n, PS_J_s
79           use ps, only: PS_Z_t, PS_Z_b, PS_K_t, PS_K_b
80     ! User specified: System geometry
81           use geometry, only: NO_I, XLENGTH
82           use geometry, only: NO_J, YLENGTH
83           use geometry, only: NO_K, ZLENGTH
84     
85     ! Global Parameters:
86     !---------------------------------------------------------------------//
87     ! The max number of BCs.
88           use param, only: DIMENSION_PS
89     ! Parameter constants
90           use param1, only: ZERO, UNDEFINED, UNDEFINED_I
91     
92     ! Use the error manager for posting error messages.
93     !---------------------------------------------------------------------//
94           use error_manager
95     
96     
97           implicit none
98     
99     
100     ! Local Variables:
101     !---------------------------------------------------------------------//
102     ! PS loop counter.
103           INTEGER :: PSV
104     !......................................................................!
105     
106     ! Initialize the error manager.
107           CALL INIT_ERR_MSG("CHECK_PS_GEOMETRY")
108     
109     ! Initialize the PS runtime flag.
110           POINT_SOURCE = .FALSE.
111     
112     ! Determine which point source indices have values.
113           PSV_LP: do PSV = 1, DIMENSION_PS
114     
115              IF (PS_X_W(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
116              IF (PS_X_E(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
117              IF (PS_Y_S(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
118              IF (PS_Y_N(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
119              IF (PS_Z_B(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
120              IF (PS_Z_T(PSV) /= UNDEFINED)   PS_DEFINED(PSV) = .TRUE.
121              IF (PS_I_W(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
122              IF (PS_I_E(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
123              IF (PS_J_S(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
124              IF (PS_J_N(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
125              IF (PS_K_B(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
126              IF (PS_K_T(PSV) /= UNDEFINED_I) PS_DEFINED(PSV) = .TRUE.
127     
128     ! Skip consistency checks if nothing was defined.
129              IF (.NOT.PS_DEFINED(PSV)) cycle PSV_LP
130     
131     ! Flag that one or more point sources has been detected.
132              POINT_SOURCE = .TRUE.
133     
134              IF(PS_X_W(PSV)==UNDEFINED .AND. PS_I_W(PSV)==UNDEFINED_I) THEN
135                 IF(NO_I) THEN
136                    PS_X_W(PSV) = ZERO
137                 ELSE
138                    WRITE(ERR_MSG,1101) PSV, 'PS_X_w and PS_I_w '
139                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
140                 ENDIF
141              ENDIF
142              IF(PS_X_E(PSV)==UNDEFINED .AND. PS_I_E(PSV)==UNDEFINED_I) THEN
143                 IF(NO_I) THEN
144                    PS_X_E(PSV) = XLENGTH
145                 ELSE
146                    WRITE(ERR_MSG,1101) PSV, 'PS_X_e and PS_I_e '
147                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
148                 ENDIF
149              ENDIF
150              IF(PS_Y_S(PSV)==UNDEFINED .AND. PS_J_S(PSV)==UNDEFINED_I) THEN
151                 IF(NO_J) THEN
152                    PS_Y_S(PSV) = ZERO
153                 ELSE
154                    WRITE(ERR_MSG,1101) PSV, 'PS_Y_s and PS_J_s '
155                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
156                 ENDIF
157              ENDIF
158              IF(PS_Y_N(PSV)==UNDEFINED .AND. PS_J_N(PSV)==UNDEFINED_I) THEN
159                 IF(NO_J) THEN
160                    PS_Y_N(PSV) = YLENGTH
161                 ELSE
162                    WRITE(ERR_MSG,1101) PSV, 'PS_Y_n and PS_J_n '
163                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
164                 ENDIF
165              ENDIF
166              IF(PS_Z_B(PSV)==UNDEFINED .AND. PS_K_B(PSV)==UNDEFINED_I) THEN
167                 IF(NO_K) THEN
168                    PS_Z_B(PSV) = ZERO
169                 ELSE
170                    WRITE(ERR_MSG,1101) PSV, 'PS_Z_b and PS_K_b '
171                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
172                 ENDIF
173              ENDIF
174              IF(PS_Z_T(PSV)==UNDEFINED .AND. PS_K_T(PSV)==UNDEFINED_I) THEN
175                 IF(NO_K) THEN
176                    PS_Z_T(PSV) = ZLENGTH
177                 ELSE
178                    WRITE(ERR_MSG,1101) PSV, 'PS_Z_t and PS_K_t '
179                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
180                 ENDIF
181              ENDIF
182     
183      1101 FORMAT('Error 1101: Point source ',I3,' is ill-defined.',/A,     &
184              ' are not specified.',/'Please correct the mfix.dat file.')
185     
186           ENDDO PSV_LP
187     
188           CALL FINL_ERR_MSG
189     
190           RETURN
191           END SUBROUTINE CHECK_PS_GEOMETRY
192     
193     
194     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
195     !                                                                      !
196     !  SUBROUTINE: CHECK_PS_GAS_PHASE                                      !
197     !  Author: J. Musser                                  Date: 10-JUN-13  !
198     !                                                                      !
199     !  Purpose: Check point source specifications.                         !
200     !                                                                      !
201     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
202           SUBROUTINE CHECK_PS_GAS_PHASE(PSV)
203     
204     ! Global Variables:
205     !---------------------------------------------------------------------//
206     ! Gas phase mass flowrate for PS
207           use ps, only: PS_MASSFLOW_G
208     ! Gas phase velocity for PS
209           use ps, only: PS_U_g, PS_V_g, PS_W_g
210     ! Gas phase tempture and species mass fractions
211           use ps, only: PS_T_g, PS_X_g
212     ! Flag: Solve energy equations.
213           use run, only: ENERGY_EQ
214     ! Flag: Solve species equations.
215           use run, only: SPECIES_EQ
216     ! Number of species.
217           use physprop, only: NMAX
218     
219     ! Global Parameters:
220     !---------------------------------------------------------------------//
221     ! Parameter constants
222           use param1, only: ZERO, ONE, UNDEFINED
223     
224     ! Use the error manager for posting error messages.
225     !---------------------------------------------------------------------//
226           use error_manager
227     
228           use toleranc
229     
230           implicit none
231     
232     ! Dummy Arguments:
233     !---------------------------------------------------------------------//
234           INTEGER, INTENT(in) :: PSV
235     
236     ! Local Variables:
237     !---------------------------------------------------------------------//
238     ! Loop counter
239           INTEGER :: N
240     ! Sum of solids mass fractions.
241           DOUBLE PRECISION :: SUM
242     !......................................................................!
243     
244     ! Initialze the error manager.
245           CALL INIT_ERR_MSG("CHECK_PS_GAS_PHASE")
246     
247     
248     ! Check mass flow and velocity
249           IF(PS_MASSFLOW_G(PSV) == UNDEFINED) THEN
250              IF(PS_U_g(PSV) /= UNDEFINED .OR. &
251                 PS_V_g(PSV) /= UNDEFINED .OR. &
252                 PS_W_g(PSV) /= UNDEFINED) THEN
253     
254                 WRITE(ERR_MSG,1100) PSV, trim(iVar('PS_MASSFLOW_G',PSV))
255                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
256     
257      1100 FORMAT('Error 1100: Invalid specification for point source ',I3,&
258              '.',/A,' is undefined but velocity is given.',/'Please ',    &
259              'correct the mfix.dat file.')
260     
261              ELSE
262                 PS_MASSFLOW_G(PSV) = ZERO
263                 PS_U_g(PSV) = ZERO
264                 PS_V_g(PSV) = ZERO
265                 PS_W_g(PSV) = ZERO
266              ENDIF
267     
268           ELSEIF(PS_MASSFLOW_G(PSV) == ZERO) THEN
269              IF(PS_U_g(PSV) /= ZERO .OR. &
270                 PS_V_g(PSV) /= ZERO .OR. &
271                 PS_W_g(PSV) /= ZERO) THEN
272     
273                 WRITE(ERR_MSG,1101) PSV, trim(iVar('PS_MASSFLOW_G',PSV))
274                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
275              ENDIF
276     
277      1101 FORMAT('Error 1101: Invalid specification for point source ',I3,&
278              '.',/A,' is zero but velocity is given.',/'Please correct ', &
279              'the mfix.dat file.')
280     
281     ! Verify a physical mass flow
282           ELSEIF(PS_MASSFLOW_G(PSV) < ZERO) THEN
283              WRITE(ERR_MSG,1102) PSV, trim(iVar('PS_MASSFLOW_G',PSV))
284              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
285     
286      1102 FORMAT('Error 1102: Invalid specifications for point source ',I3,&
287              '.',/A,' < 0.0. Point sources can only add mass to a system',/&
288              'Please correct the mfix.dat file.')
289     
290     
291     ! Mass flow is specified:
292           ELSE
293     
294     ! Velocity does not have to be defined (no momentum source). If the
295     ! components are UNDEFINED, zero them out.
296              IF(PS_U_g(PSV) == UNDEFINED) PS_U_g(PSV) = ZERO
297              IF(PS_V_g(PSV) == UNDEFINED) PS_V_g(PSV) = ZERO
298              IF(PS_W_g(PSV) == UNDEFINED) PS_W_g(PSV) = ZERO
299     
300     ! Sum together defiend gas phase species mass fractions.
301              SUM = ZERO
302              DO N = 1, NMAX(0)
303                 IF(PS_X_G(PSV,N) /= UNDEFINED) THEN
304                    SUM = SUM + PS_X_G(PSV,N)
305                 ELSE
306                    PS_X_G(PSV,N) = ZERO
307                 ENDIF
308              ENDDO
309     
310     ! Enforce that the species mass fractions must sum to one.
311              IF(.NOT.COMPARE(ONE,SUM)) THEN
312     
313                 IF(SPECIES_EQ(0)) THEN
314                    WRITE(ERR_MSG, 1110) PSV
315                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
316     
317      1110 FORMAT('Error 1110: PS_X_g(',I3,',:) do NOT sum to ONE and the ',&
318              'gas phase',/'species equations are solved. Please correct ', &
319              'the mfix.dat file.')
320     
321                 ELSEIF(.NOT.COMPARE(SUM,ZERO)) THEN
322                    WRITE(ERR_MSG, 1111) PSV
323                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
324     
325      1111 FORMAT('Error 1111: PS_X_g(',I3,',:) do not sum to ONE or ZERO ',&
326              'and they',/'are not needed. Please correct the mfix.dat ',   &
327              'the mfix.dat file.')
328     
329                 ELSE
330                    PS_X_G(PSV,:) = ZERO
331                    PS_X_G(PSV,1) = ONE
332                 ENDIF
333     
334              ENDIF
335     
336     ! Verify that a temperature is provided.
337              IF(ENERGY_EQ)THEN
338                 IF(PS_T_g(PSV) == UNDEFINED) THEN
339                    WRITE(ERR_MSG,1000) trim(iVar('PS_T_g',PSV))
340                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
341     
342     ! Verify that a given temperature is physical.
343                 ELSEIF(PS_T_g(PSV) <= ZERO) THEN
344                    WRITE(ERR_MSG,1001) PSV, trim(iVar('PS_T_g',PSV)),      &
345                       trim(iVal(PS_T_g(PSV)))
346                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
347                 ENDIF
348              ENDIF
349     
350           ENDIF
351     
352           CALL FINL_ERR_MSG
353     
354           RETURN
355     
356      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
357              'correct the mfix.dat file.')
358     
359      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/      &
360              'Please correct the mfix.dat file.')
361     
362           END SUBROUTINE CHECK_PS_GAS_PHASE
363     
364     
365     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
366     !                                                                      !
367     !  SUBROUTINE: CHECK_PS_SOLIDS_PHASES                                  !
368     !  Author: J. Musser                                  Date: 10-JUN-13  !
369     !                                                                      !
370     !  Purpose: Check point source specifications.                         !
371     !                                                                      !
372     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
373           SUBROUTINE CHECK_PS_SOLIDS_PHASES(PSV)
374     
375     ! Global Variables:
376     !---------------------------------------------------------------------//
377     ! Solids phase mass flowrate for PS
378           use ps, only: PS_MASSFLOW_S
379     ! Solids phase velocity for PS
380           use ps, only: PS_U_s, PS_V_s, PS_W_s
381     ! Solids phase tempture and species mass fractions
382           use ps, only: PS_T_s, PS_X_s
383     ! Flag: Solve energy equations.
384           use run, only: ENERGY_EQ
385     ! Flag: Solve species equations.
386           use run, only: SPECIES_EQ
387     ! Type of each solids phase.
388           use run, only: SOLIDS_MODEL
389     ! Number of (TFM) solids.
390           use physprop, only: SMAX
391     ! Number of discrete solids phases.
392           use discretelement, only: DES_MMAX
393     ! Number of slolids species.
394           use physprop, only: SMAX, NMAX
395     
396     ! Global Parameters:
397     !---------------------------------------------------------------------//
398     ! Parameter constants
399           use param1, only: ZERO, ONE, UNDEFINED
400     
401     ! Use the error manager for posting error messages.
402     !---------------------------------------------------------------------//
403           use error_manager
404     
405           use toleranc
406     
407           implicit none
408     
409     ! Dummy Arguments:
410     !---------------------------------------------------------------------//
411           INTEGER, INTENT(in) :: PSV
412     
413     ! Local Variables:
414     !---------------------------------------------------------------------//
415     ! Total number of solid phases
416           INTEGER :: MMAX_TOT
417     ! Loop counters
418           INTEGER :: M, N
419     ! Sum of solids mass fractions.
420           DOUBLE PRECISION :: SUM
421     !......................................................................!
422     
423     ! Initialize the error manager.
424           CALL INIT_ERR_MSG("CHECK_PS_SOLIDS_PHASES")
425     
426     ! The total number of solids phases (all models).
427           MMAX_TOT = SMAX + DES_MMAX
428     
429           DO M=1, MMAX_TOT
430     
431     ! Check mass flow and velocity
432              IF(PS_MASSFLOW_S(PSV,M) == UNDEFINED) THEN
433                 IF(PS_U_s(PSV,M) /= UNDEFINED .OR. &
434                    PS_V_s(PSV,M) /= UNDEFINED .OR. &
435                    PS_W_s(PSV,M) /= UNDEFINED) THEN
436     
437                    WRITE(ERR_MSG,1100)PSV, trim(iVar('PS_MASSFLOW_S',PSV,M))
438                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
439     
440      1100 FORMAT('Error 1100: Invalid specification for point source ',I3,&
441              '.',/A,' is undefined but velocity is given.',/'Please ',    &
442              'correct the mfix.dat file.')
443     
444                 ELSE
445                    PS_MASSFLOW_S(PSV,M) = ZERO
446                    PS_U_s(PSV,M) = ZERO
447                    PS_V_s(PSV,M) = ZERO
448                    PS_W_s(PSV,M) = ZERO
449                 ENDIF
450     
451              ELSEIF(PS_MASSFLOW_S(PSV,M) == ZERO) THEN
452                 IF(PS_U_s(PSV,M) /= ZERO .OR. &
453                    PS_V_s(PSV,M) /= ZERO .OR. &
454                    PS_W_s(PSV,M) /= ZERO) THEN
455     
456                    WRITE(ERR_MSG,1101)PSV, trim(iVar('PS_MASSFLOW_S',PSV,M))
457                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
458                 ENDIF
459     
460      1101 FORMAT('Error 1100: Invalid specification for point source ',I3,&
461              '.',/A,' is zero but velocity is given.',/'Please correct ', &
462              'the mfix.dat file.')
463     
464              ELSEIF(PS_MASSFLOW_S(PSV,M) < ZERO) THEN
465                 WRITE(ERR_MSG,1102) PSV, trim(iVar('PS_MASSFLOW_S',PSV,M))
466                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
467     
468      1102 FORMAT('Error 1102: Invalid specifications for point source ',I3,&
469              '.',/A,' < 0.0. Point sources can only add mass to a system',/&
470              'Please correct the mfix.dat file.')
471     
472     
473     ! Mass flow is specified:
474              ELSE
475     
476     ! Currently, only TFM solids can be used with point sources. However,
477     ! the could be implemented for PIC solids as well.
478                 SELECT CASE(SOLIDS_MODEL(M))
479                 CASE ('DEM','PIC')
480                    WRITE(ERR_MSG, 1110) PSV, SOLIDS_MODEL(M)
481                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
482                 CASE DEFAULT
483                 END SELECT
484     
485      1110 FORMAT('Error 1110: Invalid specifications for point source ',I3,&
486              '.',/'Point sources are not supported for ',A,' solids.',/    &
487              'Please correct the mfix.dat file.')
488     
489     ! Velocity does not have to be defined (no momentum source). If the
490     ! components are UNDEFINED, zero them out.
491                 IF(PS_U_s(PSV,M) == UNDEFINED) PS_U_s(PSV,M) = ZERO
492                 IF(PS_V_s(PSV,M) == UNDEFINED) PS_V_s(PSV,M) = ZERO
493                 IF(PS_W_s(PSV,M) == UNDEFINED) PS_W_s(PSV,M) = ZERO
494     
495     ! Sum together defiend gas phase species mass fractions.
496                 SUM = ZERO
497                 DO N = 1, NMAX(M)
498                    IF(PS_X_S(PSV,M,N) /= UNDEFINED) THEN
499                    SUM = SUM + PS_X_S(PSV,M,N)
500                    ELSE
501                       PS_X_S(PSV,M,N) = ZERO
502                    ENDIF
503                 ENDDO
504     
505     ! Enforce that the species mass fractions must sum to one.
506                 IF(.NOT.COMPARE(ONE,SUM)) THEN
507     
508                    IF(SPECIES_EQ(M)) THEN
509                       WRITE(ERR_MSG, 1120) PSV,M
510                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
511     
512      1120 FORMAT('Error 1120: PS_X_s(',I3,',',I2,',:) do NOT sum to ONE ', &
513              'and the solids phase',/'species equations are solved. ',     &
514              'Please correct the mfix.dat file.')
515     
516                    ELSEIF(.NOT.COMPARE(SUM,ZERO)) THEN
517                       WRITE(ERR_MSG, 1121) PSV,M
518                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
519     
520      1121 FORMAT('Error 1121: PS_X_s(',I3,',',I2,',:) do not sum to ONE ', &
521              'or ZERO and they',/'are not needed. Please correct the ',    &
522              'mfix.dat the mfix.dat file.')
523     
524                    ELSE
525                       PS_X_S(PSV,M,1)  = ONE
526                       PS_X_S(PSV,M,2:) = ZERO
527                    ENDIF
528     
529                 ENDIF
530     
531     ! Verify that a temperature is provided.
532                 IF(ENERGY_EQ)THEN
533                    IF(PS_T_s(PSV,M) == UNDEFINED) THEN
534                       WRITE(ERR_MSG,1000) trim(iVar('PS_T_s',PSV,M))
535                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
536     
537     ! Verify that a given temperature is physical.
538                    ELSEIF(PS_T_s(PSV,M) <= ZERO) THEN
539                       WRITE(ERR_MSG,1001) PSV, trim(iVar('PS_T_s',PSV,M)), &
540                          trim(iVal(PS_T_s(PSV,M)))
541                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
542                    ENDIF
543                 ENDIF
544              ENDIF
545           ENDDO
546     
547           CALL FINL_ERR_MSG
548     
549           RETURN
550     
551      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
552              'correct the mfix.dat file.')
553     
554      1001 FORMAT('Error 1001: Illegal or unknown input: ',A,' = ',A,/      &
555              'Please correct the mfix.dat file.')
556     
557           END SUBROUTINE CHECK_PS_SOLIDS_PHASES
558     
559     
560     
561     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
562     !                                                                      !
563     !  SUBROUTINE: CHECK_PS_OVERFLOW                                       !
564     !  Author: J. Musser                                  Date: 10-JUN-13  !
565     !                                                                      !
566     !  Purpose: Check point source specifications.                         !
567     !                                                                      !
568     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
569           SUBROUTINE CHECK_PS_OVERFLOW(PSV)
570     
571     ! Global Variables:
572     !---------------------------------------------------------------------//
573     ! Gas phase mass flowrate for PS and velocities
574           use ps, only: PS_MASSFLOW_G, PS_U_g, PS_V_g, PS_W_g
575     ! Gas phase tempture and species mass fractions
576           use ps, only: PS_T_g, PS_X_g
577     ! Solids phase mass flowrate and velocity
578           use ps, only: PS_MASSFLOW_S, PS_U_s, PS_V_s, PS_W_s
579     ! Solids phase tempture and species mass fractions
580           use ps, only: PS_T_s, PS_X_s
581     ! Flag: Solve energy equations.
582           use run, only: ENERGY_EQ
583     ! Flag: Solve species equations.
584           use run, only: SPECIES_EQ
585     
586     ! Global Parameters:
587     !---------------------------------------------------------------------//
588     ! Maximum input array sizes.
589           use param, only: DIM_M, DIM_N_g, DIM_N_s
590     ! Parameter constants
591           use param1, only: ZERO, ONE, UNDEFINED
592     
593     ! Use the error manager for posting error messages.
594     !---------------------------------------------------------------------//
595           use error_manager
596     
597     
598           implicit none
599     
600     
601     ! Dummy Arguments:
602     !---------------------------------------------------------------------//
603           INTEGER, INTENT(in) :: PSV
604     
605     ! Local Variables:
606     !---------------------------------------------------------------------//
607     ! Loop counters
608           INTEGER :: M, N
609     !......................................................................!
610     
611     
612     ! Initialize the error manager.
613           CALL INIT_ERR_MSG("CHECK_PS_OVERFLOW")
614     
615     
616           IF(PS_MASSFLOW_G(PSV) /= UNDEFINED) THEN
617              WRITE(ERR_MSG,1010) trim(iVar('PS_MASSFLOW_G',PSV))
618              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
619           ELSEIF(PS_U_g(PSV) /= UNDEFINED) THEN
620              WRITE(ERR_MSG,1010) trim(iVar('PS_U_g',PSV))
621              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
622           ELSEIF(PS_V_g(PSV) /= UNDEFINED) THEN
623              WRITE(ERR_MSG,1010) trim(iVar('PS_V_g',PSV))
624              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
625           ELSEIF(PS_W_g(PSV) /= UNDEFINED) THEN
626              WRITE(ERR_MSG,1010) trim(iVar('PS_W_g',PSV))
627              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
628           ELSEIF(PS_T_g(PSV) /= UNDEFINED) THEN
629              WRITE(ERR_MSG,1010) trim(iVar('PS_T_g',PSV))
630              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
631           ENDIF
632           DO N = 1, DIM_N_G
633              IF(PS_X_G(PSV,N) /= UNDEFINED) THEN
634                 WRITE(ERR_MSG,1010) trim(iVar('PS_X_G',PSV,N))
635                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
636              ENDIF
637           ENDDO
638     
639           DO M=1, DIM_M
640              IF(PS_MASSFLOW_S(PSV,M) /= UNDEFINED) THEN
641                 WRITE(ERR_MSG,1010) trim(iVar('PS_MASSFLOW_S',PSV,M))
642                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
643              ELSEIF(PS_U_s(PSV,M) /= UNDEFINED) THEN
644                 WRITE(ERR_MSG,1010) trim(iVar('PS_U_s',PSV,M))
645                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
646              ELSEIF(PS_V_s(PSV,M) /= UNDEFINED) THEN
647                 WRITE(ERR_MSG,1010) trim(iVar('PS_V_s',PSV,M))
648                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
649              ELSEIF(PS_W_s(PSV,M) /= UNDEFINED) THEN
650                 WRITE(ERR_MSG,1010) trim(iVar('PS_W_s',PSV,M))
651                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
652              ELSEIF(PS_T_s(PSV,M) /= UNDEFINED) THEN
653                 WRITE(ERR_MSG,1010) trim(iVar('PS_T_s',PSV,M))
654                 CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
655              ENDIF
656              DO N = 1, DIM_N_S
657                 IF(PS_X_S(PSV,M,N) /= UNDEFINED) THEN
658                    WRITE(ERR_MSG,1010) trim(iVar('PS_X_S',PSV,M,N))
659                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
660                 ENDIF
661              ENDDO
662           ENDDO
663     
664           CALL FINL_ERR_MSG
665     
666           RETURN
667     
668      1010 FORMAT('Error 1010: ',A,' specified in an undefined PS region.')
669     
670           END SUBROUTINE CHECK_PS_OVERFLOW
671