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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: CHECK_DATA_30                                          C
4     !  Purpose: Check whether the sum of reaction rates is zero and the sumC
5     !           of mass fractions is 1.0                                   C
6     !           and EP_g >= EP_star. Set miscellaneous constants           C
7     !                                                                      C
8     !  Author: M. Syamlal                                 Date: 27-OCT-92  C
9     !  Reviewer: W. Rogers                                Date: 11-DEC-92  C
10     !                                                                      C
11     !  Literature/Document References:                                     C
12     !                                                                      C
13     !  Variables referenced:                                               C
14     !  Variables modified:                                                 C
15     !                                                                      C
16     !  Local variables: ABORT, SUM                                         C
17     !                                                                      C
18     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
19     !
20           SUBROUTINE CHECK_DATA_30
21     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
22     !...Switches: -xf
23     !
24     !  Include param.inc file to specify parameter values
25     !
26     !-----------------------------------------------
27     !   M o d u l e s
28     !-----------------------------------------------
29           USE param
30           USE param1
31           USE toleranc
32           USE fldvar
33           USE rxns
34           USE visc_s
35           USE visc_g
36           USE geometry
37           USE run
38           USE constant
39           USE physprop
40           USE indices
41           USE funits
42           USE compar
43           USE mpi_utility
44           USE discretelement
45           USE mms
46           USE functions
47     
48           IMPLICIT NONE
49     !-----------------------------------------------
50     !   G l o b a l   P a r a m e t e r s
51     !-----------------------------------------------
52     !-----------------------------------------------
53     !   L o c a l   P a r a m e t e r s
54     !-----------------------------------------------
55     !-----------------------------------------------
56     !   L o c a l   V a r i a b l e s
57     !-----------------------------------------------
58     !
59     !                      Indices
60           INTEGER          I, J, K, IJK
61     !
62     !                      Solids phase
63           INTEGER          M
64     !
65     !                      Species index
66           INTEGER          N
67     !
68     !                      Logical variable to set, if there is an error
69           LOGICAL          ABORT
70     !
71     !                      Logical variable to set, if there is a message
72           LOGICAL          MESSAGE
73     !
74     !                      sum of mass fractions or reaction rates
75           DOUBLE PRECISION lSUM
76     !
77     !                      Logical variable to set, if there is a message
78           LOGICAL          MESSAGE_X_g
79     !
80     !                      minimum sum of gas species mass fractions
81           DOUBLE PRECISION SUM_MIN_g
82     !
83     !                      maximum sum of gas species mass fractions
84           DOUBLE PRECISION SUM_MAX_g
85     !
86     !                      Location of minimum
87           INTEGER          I_MIN_g, J_MIN_g, K_MIN_g
88     !
89     !                      Location of maximum
90           INTEGER          I_MAX_g, J_MAX_g, K_MAX_g
91     !
92     !                      Distribution of the sum of gas species mass fractions
93           INTEGER          COUNT_g(9)
94     !
95     !                      Total count
96           INTEGER          SUM_COUNT
97     !
98     !                      Fractional distribution of the sum of species mass fr.
99           DOUBLE PRECISION FR_COUNT(9)
100     !
101     !                      Logical variable to set, if there is a message
102           LOGICAL          MESSAGE_X_s (DIMENSION_M)
103     !
104     !                      minimum sum of solids species mass fractions
105           DOUBLE PRECISION SUM_MIN_s (DIMENSION_M)
106     !
107     !                      maximum sum of gas species mass fractions
108           DOUBLE PRECISION SUM_MAX_s (DIMENSION_M)
109     !
110     !                      Location of minimum
111           INTEGER          I_MIN_s(DIMENSION_M), J_MIN_s(DIMENSION_M),&
112                            K_MIN_s(DIMENSION_M)
113     !
114     !                      Location of maximum
115           INTEGER          I_MAX_s(DIMENSION_M), J_MAX_s(DIMENSION_M),&
116                            K_MAX_s(DIMENSION_M)
117     !
118     !                      Distribution of the sum of gas species mass fractions
119           INTEGER          COUNT_s (DIMENSION_M, 9)
120     !
121     !                      Do-loop counter
122           INTEGER          L, LM
123     !
124     !                      There is a discrepancy in rxn sums
125           LOGICAL          MESSAGE_rxnsum
126     !
127     !                      maximum discrepancy in rxn sums
128           DOUBLE PRECISION RXNSUM_MAX
129     !
130     !                      Location of maximum discrepancy in rxn sums
131           INTEGER          I_RXNSUM_MAX, J_RXNSUM_MAX, K_RXNSUM_MAX
132     !
133     !                      Distribution of the sum of gas species mass fractions
134           INTEGER          COUNT_RXNSUM0, COUNT_RXNSUM1
135     !
136     !                      There is a discrepancy in interphase mass transfer
137           LOGICAL          MESSAGE_masstr(0:DIMENSION_M)
138     !
139     !                      maximum discrepancy in interphase mass transfer
140           DOUBLE PRECISION masstr_MAX(0:DIMENSION_M)
141     !
142     !                      Location of maximum discrepancy in interphase mass transfer
143           INTEGER          I_masstr_MAX(0:DIMENSION_M), J_masstr_MAX(0:DIMENSION_M),&
144                            K_masstr_MAX(0:DIMENSION_M)
145     !
146     !                      number of cells with minor and major discrepancy
147           INTEGER          COUNT_masstr0(0:DIMENSION_M), COUNT_masstr1(0:DIMENSION_M)
148     !
149     !                      errror  flag
150           INTEGER          IER
151     !
152     !-----------------------------------------------
153     
154     ! For DM parallel runs we redo these checks again from here so that all processors can write
155     ! log files.  There is a goto statement at the end to start from statement no. 1.
156     1     MESSAGE_rxnsum = .false.
157           RXNSUM_MAX     = ZERO
158           COUNT_RXNSUM0  = 0
159           COUNT_RXNSUM1  = 0
160     
161           MESSAGE_masstr = .false.
162           masstr_MAX     = ZERO
163           COUNT_masstr0  = 0
164           COUNT_masstr1  = 0
165     !
166     
167           MESSAGE_X_G = .FALSE.
168           I_MIN_G = 0
169           J_MIN_G = 0
170           K_MIN_G = 0
171           I_MAX_G = 0
172           J_MAX_G = 0
173           K_MAX_G = 0
174           SUM_MIN_G = ONE
175           SUM_MAX_G = ONE
176           COUNT_G = 0
177           L = 10
178           M = 1
179           IF (MMAX > 0) THEN
180              MESSAGE_X_S(:MMAX) = .FALSE.
181              I_MIN_S(:MMAX) = 0
182              J_MIN_S(:MMAX) = 0
183              K_MIN_S(:MMAX) = 0
184              I_MAX_S(:MMAX) = 0
185              J_MAX_S(:MMAX) = 0
186              K_MAX_S(:MMAX) = 0
187              SUM_MIN_S(:MMAX) = ONE
188              SUM_MAX_S(:MMAX) = ONE
189              COUNT_S(:MMAX,:9) = 0
190              L = 10
191              M = MMAX + 1
192           ENDIF
193           CALL START_LOG
194           ABORT = .FALSE.
195           MESSAGE = .FALSE.
196     
197           DO K = KSTART2, KEND2
198              DO J = JSTART2, JEND2
199                 DO I = ISTART2, IEND2
200                    IJK = FUNIJK(I,J,K)
201                    IF (.NOT.WALL_AT(IJK)) THEN
202     
203     ! Verify that inflow/outflow cells do not contain physical properties
204     ! for the following variables.
205     !---------------------------------------------------------------------//
206     ! This check is skipped for MMS runs because ghost cells are assigned
207     ! values in these cases making the following checks invalid.
208                       IF(FLOW_AT(IJK) .AND. (.NOT.(USE_MMS))) THEN
209     
210     ! Turbulent viscosity of fluid phase.
211                          IF(MU_gt(IJK) /= ZERO) THEN
212                             IF (.NOT.MESSAGE) THEN
213                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
214                                MESSAGE = .TRUE.
215                             ENDIF
216                             IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
217                                I, J, K, MU_gt(IJK), 'MU_gt'
218                             ABORT = .TRUE.
219                          ENDIF
220     ! Granular second coefficient of viscosity.
221                          IF(LAMBDA_gt(IJK) /= ZERO) THEN
222                             IF (.NOT.MESSAGE) THEN
223                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
224                                MESSAGE = .TRUE.
225                             ENDIF
226                             IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
227                                I, J, K, LAMBDA_gt(IJK), 'LAMBDA_gt'
228                             ABORT = .TRUE.
229                                ENDIF
230     ! Gas conductivity.
231                          IF(K_g(IJK) /= ZERO) THEN
232                             IF (.NOT.MESSAGE) THEN
233                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
234                                MESSAGE = .TRUE.
235                             ENDIF
236                             IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
237                                I, J, K, K_g(IJK), 'K_g'
238                             ABORT = .TRUE.
239                          ENDIF
240     ! Diffusivity of gas species N.
241                          DO N = 1, NMAX(0)
242                             IF( DIF_g(IJK, N) /= ZERO) THEN
243                                IF (.NOT.MESSAGE) THEN
244                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
245                                   MESSAGE = .TRUE.
246                                ENDIF
247                                IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
248                                   I, J, K, DIF_g(IJK, N), 'DIF_g'
249                                ABORT = .TRUE.
250                             ENDIF
251                          ENDDO
252     
253                          IF(.NOT.DISCRETE_ELEMENT)then
254                             DO M = 1, MMAX
255     ! Granular first coefficient of (shear) viscosity.
256                                IF(MU_s(IJK, M) /= ZERO) THEN
257                                   IF (.NOT.MESSAGE) THEN
258                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
259                                      MESSAGE = .TRUE.
260                                   ENDIF
261                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
262                                      I, J, K, MU_s(IJK, M), 'MU_s'
263                                   ABORT = .TRUE.
264                                ENDIF
265     ! Granular second coefficient of viscosity.
266                                IF(LAMBDA_s(IJK, M) /= ZERO) THEN
267                                   IF (.NOT.MESSAGE) THEN
268                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
269                                      MESSAGE = .TRUE.
270                                   ENDIF
271                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
272                                      I, J, K, LAMBDA_s(IJK, M), 'LAMBDA_s'
273                                   ABORT = .TRUE.
274                                  ENDIF
275     ! Solids thermal conductivity.
276                                IF(K_s(IJK, M) /= ZERO) THEN
277                                   IF (.NOT.MESSAGE) THEN
278                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
279                                      MESSAGE = .TRUE.
280                                   ENDIF
281                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
282                                      I, J, K, K_s(IJK, M), 'K_s'
283                                   ABORT = .TRUE.
284                                ENDIF
285     ! Diffusivity of solids phase M, species N.
286                                DO N = 1, NMAX(M)
287                                   IF( DIF_s(IJK, M, N) /= ZERO) THEN
288                                      IF (.NOT.MESSAGE) THEN
289                                         IF(DMP_LOG)WRITE (UNIT_LOG, 1000) &
290                                            TIME
291                                         MESSAGE = .TRUE.
292                                      ENDIF
293                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1140) &
294                                         I, J, K, DIF_s(IJK, M, N), 'DIF_s'
295                                      ABORT = .TRUE.
296                                   ENDIF
297                                ENDDO
298                             ENDDO
299                          ENDIF
300                       ENDIF
301     
302     ! Verify that fluid cells have physical values for the following
303     ! Gas phase variables.
304     !---------------------------------------------------------------------//
305     !   Gas viscosity must be non-negative.
306                       IF (MU_G(IJK) < ZERO) THEN
307                          IF (.NOT.MESSAGE) THEN
308                             IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
309                             MESSAGE = .TRUE.
310                          ENDIF
311                          IF(DMP_LOG)WRITE (UNIT_LOG,1110) I, J, K, MU_G(IJK)
312                          ABORT = .TRUE.
313                       ENDIF
314     ! Mixture molecular weight must be positive.
315                       IF (MW_MIX_G(IJK) <= ZERO) THEN
316                          IF (.NOT.MESSAGE) THEN
317                             IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
318                             MESSAGE = .TRUE.
319                          ENDIF
320                          IF(DMP_LOG) WRITE (UNIT_LOG, 1111) &
321                             I, J, K, MW_MIX_G(IJK)
322                          ABORT = .TRUE.
323                       ENDIF
324     
325     ! Verify thermodynamic properties when solving energy equations:
326                       IF(ENERGY_EQ) THEN
327     ! Gas conductivity must be non-negative.
328                          IF (K_G(IJK) < ZERO) THEN
329                             IF (.NOT.MESSAGE) THEN
330                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
331                                MESSAGE = .TRUE.
332                             ENDIF
333                             IF(DMP_LOG)WRITE (UNIT_LOG, 1120) &
334                                I, J, K, K_G(IJK)
335                             ABORT = .TRUE.
336                          ENDIF
337     ! Gas phase specific heat must be positive.
338                          IF (C_PG(IJK) <= ZERO) THEN
339                             IF (.NOT.MESSAGE) THEN
340                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
341                                MESSAGE = .TRUE.
342                             ENDIF
343                             IF(DMP_LOG)WRITE (UNIT_LOG, 1130) &
344                                I, J, K, C_PG(IJK)
345                             ABORT = .TRUE.
346                          ENDIF
347     ! Verify that the gas phase temperature is within the bounds.
348                          IF(T_G(IJK)<=TMIN .OR. T_G(IJK)>=TMAX) THEN
349                             IF (.NOT.MESSAGE) THEN
350                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
351                                MESSAGE = .TRUE.
352                             ENDIF
353                             IF(DMP_LOG)WRITE (UNIT_LOG, 1400) &
354                                I, J, K, T_G(IJK)
355                             ABORT = .TRUE.
356                          ENDIF
357                       ENDIF
358     
359     ! Diffusivity of gas species N must be non-negative.
360                       DO N = 1, NMAX(0)
361                          IF( DIF_g(IJK, N) < ZERO) THEN
362                             IF (.NOT.MESSAGE) THEN
363                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
364                                MESSAGE = .TRUE.
365                             ENDIF
366                             IF(DMP_LOG)WRITE (UNIT_LOG, 1131) &
367                                I, J, K, DIF_g(IJK, N)
368                             ABORT = .TRUE.
369                          ENDIF
370                       ENDDO
371     
372     ! Verify that the gas phase mass fractons sum to one.
373                       IF (SPECIES_EQ(0)) THEN
374                          lSUM = ZERO
375                          N = 1
376                          lSUM = sum(   X_G(IJK,1:NMAX(0))   )
377                          IF (ABS(ONE - lSUM) > TOL_COM) THEN
378                             IF (.NOT.MESSAGE) THEN
379                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
380                                MESSAGE = .TRUE.
381                             ENDIF
382                             MESSAGE_X_G = .TRUE.
383                          ENDIF
384                          IF (lSUM < SUM_MIN_G) THEN
385                             SUM_MIN_G = lSUM
386                             I_MIN_G = I
387                             J_MIN_G = J
388                             K_MIN_G = K
389                          ELSE IF (lSUM > SUM_MAX_G) THEN
390                             SUM_MAX_G = lSUM
391                             I_MAX_G = I
392                             J_MAX_G = J
393                             K_MAX_G = K
394                          ENDIF
395                          IF (lSUM < 0.9) THEN         ! < 0.9
396                             COUNT_G(1) = COUNT_G(1) + 1
397                          ELSE IF (lSUM < 0.99) THEN   ! 0.9    - 0.99
398                             COUNT_G(2) = COUNT_G(2) + 1
399                          ELSE IF (lSUM < 0.999) THEN  ! 0.99   - 0.999
400                             COUNT_G(3) = COUNT_G(3) + 1
401                          ELSE IF (lSUM < 0.9999) THEN ! 0.999  - 0.9999
402                             COUNT_G(4) = COUNT_G(4) + 1
403                          ELSE IF (lSUM < 1.0001) THEN ! 0.9999 - 1.0001
404                             COUNT_G(5) = COUNT_G(5) + 1
405                          ELSE IF (lSUM < 1.001) THEN  ! 1.0001 - 1.001
406                             COUNT_G(6) = COUNT_G(6) + 1
407                          ELSE IF (lSUM < 1.01) THEN   ! 1.001  - 1.01
408                             COUNT_G(7) = COUNT_G(7) + 1
409                          ELSE IF (lSUM < 1.1) THEN    ! 1.01   - 1.1
410                             COUNT_G(8) = COUNT_G(8) + 1
411                          ELSE                        ! > 1.1
412                             COUNT_G(9) = COUNT_G(9) + 1
413                          ENDIF
414                       ENDIF
415     
416     
417                       IF(.NOT.DISCRETE_ELEMENT)THEN
418                          DO M = 1, MMAX
419     
420     ! Verify that fluid cells have physical values for the following
421     ! Solids phase M variables.
422     !---------------------------------------------------------------------//
423     ! Solids viscosity should be non-negativel.
424                             IF (MU_S(IJK,M) < ZERO) THEN
425                                IF (.NOT.MESSAGE) THEN
426                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
427                                   MESSAGE = .TRUE.
428                                ENDIF
429                                IF(DMP_LOG)WRITE (UNIT_LOG, 1310) &
430                                   I, J, K, M, MU_S(IJK,M)
431                                ABORT = .TRUE.
432                             ENDIF
433     
434     ! Verify thermodynamic properties when solving energy equations:
435                             IF (ENERGY_EQ) THEN
436     ! Thermal conductivity must be non-negative.
437                                IF (K_S(IJK,M) < ZERO) THEN
438                                   IF (.NOT.MESSAGE) THEN
439                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
440                                      MESSAGE = .TRUE.
441                                   ENDIF
442                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1320) &
443                                      I, J, K, M, K_S(IJK,M)
444                                   ABORT = .TRUE.
445                                ENDIF
446     ! Solids specific heat must be positive.
447                                IF (C_PS(IJK,M) <= ZERO) THEN
448                                   IF (.NOT.MESSAGE) THEN
449                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
450                                      MESSAGE = .TRUE.
451                                   ENDIF
452                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1330) &
453                                      I, J, K, M, C_PS(IJK,M)
454                                   ABORT = .TRUE.
455                                ENDIF
456     ! Verify that the solids temperature is within the required bounds.
457                                IF((T_S(IJK,M)<=TMIN .OR. &
458                                   T_S(IJK,M)>=TMAX)) THEN
459                                   IF (.NOT.MESSAGE) THEN
460                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
461                                      MESSAGE = .TRUE.
462                                   ENDIF
463                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1410) &
464                                      I, J, K, M, T_S(IJK,M)
465                                   ABORT = .TRUE.
466                                ENDIF
467                             ENDIF
468     
469                             DO N = 1, NMAX(M)
470                                IF( DIF_s(IJK, M, N) < ZERO) THEN
471                                   IF (.NOT.MESSAGE) THEN
472                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
473                                      MESSAGE = .TRUE.
474                                   ENDIF
475                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1331) &
476                                      I, J, K, M, DIF_s(IJK, M, N)
477                                   ABORT = .TRUE.
478                                ENDIF
479                             ENDDO
480     
481     !  Sum of solids mass fractions should be one
482                             IF (SPECIES_EQ(M)) THEN
483                                lSUM = sum(X_S(IJK,M,1:NMAX(M)) )
484     
485                                IF (ROP_S(IJK,M) /= ZERO) THEN
486                                   IF (ABS(ONE - lSUM) > TOL_COM) THEN
487                                      IF (.NOT.MESSAGE) THEN
488                                         IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
489                                         MESSAGE = .TRUE.
490                                      ENDIF
491                                      MESSAGE_X_S(M) = .TRUE.
492                                   ENDIF
493                                    IF (lSUM < SUM_MIN_S(M)) THEN
494                                       SUM_MIN_S(M) = lSUM
495                                       I_MIN_S(M) = I
496                                       J_MIN_S(M) = J
497                                       K_MIN_S(M) = K
498                                    ELSE IF (lSUM > SUM_MAX_S(M)) THEN
499                                       SUM_MAX_S(M) = lSUM
500                                       I_MAX_S(M) = I
501                                       J_MAX_S(M) = J
502                                       K_MAX_S(M) = K
503                                    ENDIF
504                                    IF (lSUM < 0.9) THEN   ! < 0.9
505                                       COUNT_S(M,1) = COUNT_S(M,1) + 1
506     !                                                ! 0.9    - 0.99
507                                    ELSE IF (lSUM < 0.99) THEN
508                                       COUNT_S(M,2) = COUNT_S(M,2) + 1
509     !                                                ! 0.99   - 0.999
510                                    ELSE IF (lSUM < 0.999) THEN
511                                       COUNT_S(M,3) = COUNT_S(M,3) + 1
512     !                                                ! 0.999  - 0.9999
513                                    ELSE IF (lSUM < 0.9999) THEN
514                                       COUNT_S(M,4) = COUNT_S(M,4) + 1
515     !                                                ! 0.9999 - 1.0001
516                                    ELSE IF (lSUM < 1.0001) THEN
517                                       COUNT_S(M,5) = COUNT_S(M,5) + 1
518     !                                                ! 1.0001 - 1.001
519                                    ELSE IF (lSUM < 1.001) THEN
520                                       COUNT_S(M,6) = COUNT_S(M,6) + 1
521     !                                                ! 1.001  - 1.01
522                                    ELSE IF (lSUM < 1.01) THEN
523                                       COUNT_S(M,7) = COUNT_S(M,7) + 1
524     !                                                ! 1.01   - 1.1
525                                    ELSE IF (lSUM < 1.1) THEN
526                                       COUNT_S(M,8) = COUNT_S(M,8) + 1
527                                    ELSE                  ! > 1.1
528                                       COUNT_S(M,9) = COUNT_S(M,9) + 1
529                                   ENDIF
530                                ENDIF
531                             ENDIF
532     
533                          ENDDO ! Loop over solids phases.
534                       ENDIF ! IF(.NOT.DISCRETE_ELEMENT)
535     
536     ! Verify that the net interphase mass transfer rates sum to zero.
537     ! This check is not needed when using the stiff chemistry solver.
538     !---------------------------------------------------------------------//
539                       IF(USE_RRATES)THEN
540     
541     ! The rate of interphase mass transfer must sum to zero over all phases.
542                          lSUM = SUM_R_G(IJK)
543                          IF (MMAX > 0) THEN
544                             DO M = 1, MMAX
545                                lSUM = lSUM + SUM_R_S(IJK,M)
546                             END DO
547                          ENDIF
548                          IF (ABS(lSUM) > SMALL_NUMBER) THEN
549                             MESSAGE_rxnsum = .true.
550                                IF(abs(lSUM) > abs(RXNSUM_MAX)) THEN
551                                   RXNSUM_MAX   = lSUM
552                                   I_RXNSUM_MAX = i
553                                   J_RXNSUM_MAX = j
554                                   K_RXNSUM_MAX = k
555                                endif
556                             IF (.NOT.MESSAGE) THEN
557                                IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
558                                MESSAGE = .TRUE.
559                             ENDIF
560     ! Forced exist if an imbalance exceeds the tollerance.
561                             IF (ABS(lSUM) > TOL_COM) then
562                                COUNT_RXNSUM1 = COUNT_RXNSUM1 + 1
563                                ABORT = .TRUE.
564                             ELSE
565     ! Count the number of cells that do not sum to one, but are below the
566     ! tollerance for force and exit.
567                                COUNT_RXNSUM0 = COUNT_RXNSUM0 + 1
568                             ENDIF
569                          ENDIF
570     
571     ! Verify that the net rate of production (SUM_R_x) matches the the total
572     ! amount of mass transferred from other phases.
573                          DO L = 0, MMAX
574                             IF (L == 0) THEN
575                                lSUM = SUM_R_G(IJK)
576                             ELSE
577                                lSUM = SUM_R_S(IJK,L)
578                             ENDIF
579                             DO M = 0, MMAX
580                                IF (M > L) THEN
581                                   LM = L + 1 + (M - 1)*M/2
582                                   lSUM = lSUM - R_PHASE(IJK,LM)
583                                ELSE IF (L > M) THEN
584                                   LM = M + 1 + (L - 1)*L/2
585                                   lSUM = lSUM + R_PHASE(IJK,LM)
586                                ENDIF
587                             END DO
588     
589                             IF (ABS(lSUM) > SMALL_NUMBER) THEN
590                                MESSAGE_masstr(L) = .true.
591                                IF(abs(lSUM) > abs(masstr_MAX(L))) THEN
592                                   masstr_MAX(L) = lSUM
593                                   I_masstr_MAX(L) = i
594                                   J_masstr_MAX(L) = j
595                                   K_masstr_MAX(L) = k
596                                ENDIF
597                                IF (.NOT.MESSAGE) THEN
598                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
599                                   MESSAGE = .TRUE.
600                                ENDIF
601     
602     ! Force an exit if an imbalance exceeds the tollerance.
603                                IF(ABS(lSUM) > TOL_COM) then
604                                   COUNT_masstr1(L) = COUNT_masstr1(L) + 1
605                                   ABORT = .TRUE.
606                                ELSE
607     ! Count the number of cells that do not sum to one, but are below the
608     ! tollerance for force and exit.
609                                   COUNT_masstr0(L) = COUNT_masstr0(L) + 1
610                                ENDIF
611                             ENDIF
612                          END DO
613     
614     
615                          IF(SPECIES_EQ(0))THEN
616     ! Verify that the rates of formation and consumption adhear to the
617     ! expected coding restraints. (non-negative)
618                             DO N = 1, NMAX(0)
619     ! Rates of production must be non-negative.
620                                IF (R_GP(IJK,N) < ZERO) THEN
621                                   IF (.NOT.MESSAGE) THEN
622                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
623                                      MESSAGE = .TRUE.
624                                   ENDIF
625                                   IF(DMP_LOG) WRITE (UNIT_LOG, 1103) &
626                                      I, J, K, R_GP(IJK,N), N
627                                   ABORT = .TRUE.
628                                ENDIF
629     ! Rates of consumption must be non-negative.
630                                IF (ROX_GC(IJK,N) < ZERO) THEN
631                                   IF (.NOT.MESSAGE) THEN
632                                      IF(DMP_LOG)WRITE (UNIT_LOG, 1000) TIME
633                                      MESSAGE = .TRUE.
634                                   ENDIF
635                                   IF(DMP_LOG)WRITE (UNIT_LOG, 1104) &
636                                      I, J, K, ROX_GC(IJK,N), N
637                                   ABORT = .TRUE.
638                                ENDIF
639                             END DO
640                          ENDIF
641     
642     ! Verify that the rates of formation and consumption adhear to the
643     ! expected coding restraints. (non-negative)
644                          IF(.NOT.DISCRETE_ELEMENT)THEN
645                             DO M = 1, MMAX
646                                IF(SPECIES_EQ(M))THEN
647                                   DO N = 1, NMAX(M)
648     ! Rates of production must be non-negative.
649                                      IF (R_SP(IJK,M,N) < ZERO) THEN
650                                         IF (.NOT.MESSAGE) THEN
651                                            IF(DMP_LOG)WRITE (UNIT_LOG,1000)&
652                                               TIME
653                                            MESSAGE = .TRUE.
654                                         ENDIF
655                                         IF(DMP_LOG)WRITE (UNIT_LOG, 1105) &
656                                            I, J, K, M, R_SP(IJK,M,N), N
657                                         ABORT = .TRUE.
658                                      ENDIF
659     ! Rates of consumption must be non-negative.
660                                      IF (ROX_SC(IJK,M,N) < ZERO) THEN
661                                         IF (.NOT.MESSAGE) THEN
662                                            IF(DMP_LOG)WRITE (UNIT_LOG,1000)&
663                                               TIME
664                                            MESSAGE = .TRUE.
665                                         ENDIF
666                                         IF(DMP_LOG)WRITE(UNIT_LOG,1106) &
667                                            I,J,K,M,ROX_SC(IJK,M,N),N
668                                         ABORT = .TRUE.
669                                      ENDIF
670                                   END DO
671                                ENDIF
672                             END DO
673                          ENDIF
674                       ENDIF ! End reaction checks
675     
676     
677                    ENDIF ! IF(.NOT.WALL_AT(IJK))
678                 ENDDO ! DO I = ISTART2, IEND2
679              ENDDO ! DO J = JSTART2, JEND2
680           ENDDO ! DO K = KSTART2, KEND2
681     
682     
683     ! Combine all error messages associated with reaction imbalances.
684     !---------------------------------------------------------------------//
685           CALL global_all_or(MESSAGE_rxnsum)
686           IF(MESSAGE_rxnsum) THEN
687              CALL global_all_sum(COUNT_RXNSUM0)
688              CALL global_all_sum(COUNT_RXNSUM1)
689              IF(DMP_LOG)WRITE(UNIT_LOG, 1415) COUNT_RXNSUM0, COUNT_RXNSUM1,&
690                 RXNSUM_MAX, I_RXNSUM_MAX, J_RXNSUM_MAX, K_RXNSUM_MAX
691           ENDIF
692     
693     ! Combine all error messages associated with mass transfer.
694     !---------------------------------------------------------------------//
695           DO L = 0, MMAX
696              CALL global_all_or(MESSAGE_masstr(L))
697              IF (MESSAGE_masstr(L)) THEN
698                 CALL global_all_sum(COUNT_masstr0(L))
699                 CALL global_all_sum(COUNT_masstr1(L))
700                 IF(DMP_LOG)WRITE (UNIT_LOG, 1420) L, COUNT_masstr0(L), &
701                    COUNT_masstr1(L), masstr_MAX(L), I_masstr_MAX(L), &
702                    J_masstr_MAX(L), K_masstr_MAX(L)
703              ENDIF
704           ENDDO
705     
706     ! Combine all error messages associated invalid species mass fractions.
707     !---------------------------------------------------------------------//
708           CALL global_all_or(MESSAGE_X_G)
709           IF (MESSAGE_X_G) THEN
710              CALL global_all_sum(COUNT_G)
711              SUM_COUNT = 0
712              DO L = 1, 9
713                 SUM_COUNT = SUM_COUNT + COUNT_G(L)
714              END DO
715              IF(DMP_LOG)WRITE (UNIT_LOG, 1430)
716              FR_COUNT = DBLE(COUNT_G)/DBLE(SUM_COUNT)
717              L = 10
718              IF(DMP_LOG)WRITE(UNIT_LOG, 1432) (COUNT_G(L),FR_COUNT(L),L=1,9)
719              IF(DMP_LOG)WRITE(UNIT_LOG, 1434) SUM_MIN_G, &
720                 I_MIN_G, J_MIN_G, K_MIN_G
721              IF(DMP_LOG)WRITE(UNIT_LOG, 1436) SUM_MAX_G, &
722                 I_MAX_G, J_MAX_G, K_MAX_G
723           ENDIF
724           DO M = 1, MMAX
725              CALL global_all_or(MESSAGE_X_S(M))
726              IF (MESSAGE_X_S(M)) THEN
727                 call global_all_sum(COUNT_S(M,:))
728                 SUM_COUNT = 0
729                 DO L = 1, 9
730                    SUM_COUNT = SUM_COUNT + COUNT_S(M,L)
731                 END DO
732                 L = 10
733                 IF(DMP_LOG)WRITE (UNIT_LOG, 1440) M
734                 FR_COUNT = DBLE(COUNT_S(M,:))/DBLE(SUM_COUNT)
735                 L = 10
736                 IF(DMP_LOG) WRITE(UNIT_LOG, 1442) &
737                    (COUNT_S(M,L),FR_COUNT(L),L=1,9)
738                 IF(DMP_LOG) WRITE(UNIT_LOG, 1444) &
739                    SUM_MIN_S(M), I_MIN_S(M), J_MIN_S(M), K_MIN_S(M)
740                 IF(DMP_LOG) WRITE(UNIT_LOG, 1446) &
741                    SUM_MAX_S(M), I_MAX_S(M), J_MAX_S(M), K_MAX_S(M)
742              ENDIF
743           END DO
744           IF (MESSAGE .AND. DMP_LOG) WRITE(UNIT_LOG, 1500)
745           CALL END_LOG
746     
747     ! Enable dmp_log, open logfile, and redo the check. This will allow
748     ! the process that generated the error to write out specific error info.
749     !---------------------------------------------------------------------//
750     
751           IF(ABORT) THEN
752              IF(.NOT.dmp_log) THEN
753                 CALL open_pe_log(ier)
754                 dmp_log = .true.
755                 GOTO 1
756              ELSE
757                 CALL MFIX_EXIT(myPE)
758              ENDIF
759           ENDIF
760     
761           RETURN
762      1000 FORMAT(/1X,70('*')//' From: CHECK_DATA_30',5X,'Time = ',G12.5,/&
763              ' Message: One or more of the following errors detected:',/&
764              '   1. Discrepancies in the reaction rates.',/&
765              '   2. Viscosity, MW, conductivity, or specific heat < zero.',/&
766              '   3. The sum of mass fractions is not equal to one.',/&
767              '   4. Temperatures at the upper or lower bound.',/&
768              '   5. The rate of production of phases (SUM_R_g or SUM_R_s)',/&
769              '      and the interphase mass transfer rates (R_Phase) are',/&
770              '      inconsistent (in subroutine RRATES).',/4X,'I',T14,'J',T24,'K',&
771              T34,'M',T45,'Value')
772      1100 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  Sum of rates .NE. 0')
773      1101 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  See message 5')
774      1103 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  R_gp < 0 for N=',I2)
775      1104 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  RoX_gc<0 for N=',I2)
776      1105 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  R_sp < 0 for N=',I2)
777      1106 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  RoX_sc<0 for N=',I2)
778      1110 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  MU_g .LT. 0')
779      1111 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  MW_MIX_g .LE. 0')
780      1120 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  K_g .LT. 0')
781      1130 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  C_pg .LE. 0')
782      1131 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  DIF_g .LT. 0')
783      1140 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,A,' .NE. 0 in a flow boundary')
784      1200 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  Sum of X_g .NE. 1')
785      1300 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  Sum of X_s .NE. 1')
786      1310 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  MU_s .LT. 0')
787      1320 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  K_s .LT. 0')
788      1330 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  C_ps .LE. 0')
789      1331 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  DIF_s .LT. 0')
790      1400 FORMAT(1X,I4,T11,I4,T21,I4,T41,G12.5,'  T_g .EQ. TMIN or TMAX')
791      1410 FORMAT(1X,I4,T11,I4,T21,I4,T31,I4,T41,G12.5,'  T_s .EQ. TMIN or TMAX')
792     ! gfortran format string bugfix (stray tab in the last line of the format statement)
793      1415 FORMAT(//1X,'Sum of all the reaction rates is not zero!',/,1X,&
794              'Number of cells with discrepancy < error tolerance = ',I5,/,1X,&
795              'Number of cells with discrepancy > error tolerance = ',I5,/,1X,&
796              'Maximum discrepancy = ',G12.5,/,1X,&
797              'Location of maximum discrepancy: I = ',I4, '  J = ', I4, '  K = ', I4&
798              )
799     ! gfortran format string bugfix (stray tab in the lst line of the format statement)
800      1420 FORMAT(//1X,'Production of phase ', I2, ' not equal to total mass transfer from other phases!',/,1X,&
801              'Number of cells with discrepancy < error tolerance = ',I5,/,1X,&
802              'Number of cells with discrepancy > error tolerance = ',I5,/,1X,&
803              'Maximum discrepancy = ',G12.5,/,1X,&
804              'Location of maximum discrepancy: I = ',I4, '  J = ', I4, '  K = ', I4&
805              )
806      1430 FORMAT(//1X,'Statistics of sum of gas species mass fraction',/,1X,&
807              'Sum of X_g',9X,'No of cells',2X,'Distribution')
808      1432 FORMAT(1X,'<0.9',T20,I4,T33,G12.5,/,1X,'0.9    - 0.99',T20,I4,T33,G12.5,/&
809              ,1X,'0.99   - 0.999',T20,I4,T33,G12.5,/,1X,'0.999  - 0.9999',T20,I4,&
810              T33,G12.5,/,1X,'0.9999 - 1.0001',T20,I4,T33,G12.5,/,1X,&
811              '1.0001 - 1.001',T20,I4,T33,G12.5,/,1X,'1.001  - 1.01',T20,I4,T33,&
812              G12.5,/,1X,'1.01   - 1.1',T20,I4,T33,G12.5,/,1X,'>1.1',T20,I4,T33,&
813              G12.5)
814      1434 FORMAT(/1X,'Minimum sum of X_g=',G12.5,'  at I=',I4,'  J=',I4,'  K=',I4)
815      1436 FORMAT(/1X,'Maximum sum of X_g=',G12.5,'  at I=',I4,'  J=',I4,'  K=',I4)
816      1440 FORMAT(//1X,'Statistics of sum of solids (',I2,') species mass fraction',&
817              /,1X,'Sum of X_s',7X,'No of cells',2X,'Distribution')
818      1442 FORMAT(1X,'<0.9',T20,I4,T33,G12.5,/,1X,'0.9    - 0.99',T20,I4,T33,G12.5,/&
819              ,1X,'0.99   - 0.999',T20,I4,T33,G12.5,/,1X,'0.999  - 0.9999',T20,I4,&
820              T33,G12.5,/,1X,'0.9999 - 1.0001',T20,I4,T33,G12.5,/,1X,&
821              '1.0001 - 1.001',T20,I4,T33,G12.5,/,1X,'1.001  - 1.01',T20,I4,T33,&
822              G12.5,/,1X,'1.01   - 1.1',T20,I4,T33,G12.5,/,1X,'>1.1',T20,I4,T33,&
823              G12.5)
824      1444 FORMAT(/1X,'Minimum sum of X_s=',G12.5,'  at I=',I4,'  J=',I4,'  K=',I4)
825      1446 FORMAT(/1X,'Maximum sum of X_s=',G12.5,'  at I=',I4,'  J=',I4,'  K=',I4)
826      1500 FORMAT(/1X,70('*')/)
827           END SUBROUTINE CHECK_DATA_30
828     
829     !// Comments on the modifications for DMP version implementation
830     !// 001 Include header file and common declarations for parallelization
831     !// 350 change do loop limits: 1,kmax2->kmin3,kmax3
832