File: N:\mfix\model\rxn_com_mod.f

1     MODULE RXN_COM
2     
3        USE compar
4        USE exit, only: mfix_exit
5        USE funits
6        USE param
7        USE param1
8     
9     ! The following data types are used to group chemical reaction data.
10     !-----------------------------------------------------------------------
11     
12     ! Species belong to PHASE_ associated with a particular reaction.
13           TYPE SPECIES_
14     ! A link between the reacting species' arbitrary index and the
15     ! associated phase index in MFiX.
16              INTEGER pMap
17     ! A link between the reacting species' arbitrary index and the
18     ! associated species index in MFiX.
19              INTEGER sMap
20     ! Stoichiometric coefficient of the species from chemical equation.
21              DOUBLE PRECISION Coeff
22     ! Molecular weight
23              DOUBLE PRECISION MW
24     ! Fractional mass transfer
25              DOUBLE PRECISION xXfr
26     ! Index indicating enthalpy transfer associated with mass transfer.
27              INTEGER mXfr
28     ! Molecular weight of speices multiplying the stoichiometric coefficient
29              DOUBLE PRECISION MWxStoich
30           END TYPE SPECIES_
31     
32     ! Grouping of reaction information.
33           TYPE REACTION_BLOCK
34     ! Name of reaction construct from data file.
35              CHARACTER(LEN=32) :: Name
36     ! User defined chemical equation from data file.
37              CHARACTER(LEN=512) :: ChemEq
38     ! Reaction classification: Homogeneous, Heterogeneous, Catalytic.
39              CHARACTER(LEN=16) :: Classification
40     ! Indicates if the automated heat of reaction is to be calculated (T) or
41     ! if the user has supplied a heat of reaction (F).
42              LOGICAL Calc_DH
43     ! Number of phases associated with the reaction.
44              INTEGER nPhases
45     ! Number of species associated with the reaction.
46              INTEGER nSpecies
47     ! User-specified heat of reaction split among phases by fracDH
48              DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: HoR
49     ! Interphase mass transfer.
50              DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: rPhase
51     ! Reactant/Product information
52              TYPE(SPECIES_), DIMENSION(:), ALLOCATABLE :: Species
53     
54           END TYPE REACTION_BLOCK
55     
56           CONTAINS
57     
58     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
59     !  Subroutine: checkDuplicateAlaises                                   !
60     !                                                                      !
61     !  Purpose: Loop through species in all phases and ensure that no two  !
62     !  entries are the same. ***Warning*** Species aliases that were not   !
63     !  specified are skipped. Non-specified aliases are treated later in   !
64     !  parse_mod.f/mapAliases.                                             !
65     !                                                                      !
66     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
67           SUBROUTINE checkDuplicateAliases(lNg, SA_g, lMMx, lNs, SA_s)
68     
69           use error_manager
70     
71           IMPLICIT NONE
72     
73     ! Number of gas speices
74           INTEGER, INTENT(IN) :: lNg
75     ! Gas phase species aliases
76           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: SA_g
77     ! Number of solids phases
78           INTEGER, INTENT(IN) :: lMMx
79     ! Number of species in each solids phase.
80           INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
81     ! Solids phase speices aliases.
82           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: SA_s
83     
84     ! Loop indices.
85           INTEGER M1, N1  ! Phase, Species
86           INTEGER M2, N2  ! Phase, Species
87     
88           CHARACTER(len=32) SA1, SA2
89     
90           CALL INIT_ERR_MSG("RXN_COM --> checkDuplicateAliases")
91     
92     ! Set variables for error messages.
93           M1 = 0
94           M2 = 0
95     ! Compare gas phase aliases.
96           DO N1 = 1, lNg
97              SA1 =SA_g(N1)
98              IF(len_trim(SA1) == 0) CYCLE
99              DO N2=N1+1,lNg
100                 SA2 = SA_g(N2)
101                 IF(len_trim(SA2) == 0) CYCLE
102                 IF(compareAliases(SA1, SA2)) GoTo 100
103              ENDDO
104     ! Compare gas and solids phase aliases.
105              DO M2 = 1, lMMx
106                 DO N2 = 1, lNs(M2)
107                    SA2 = SA_s(M2,N2)
108                    IF(len_trim(SA2) == 0) CYCLE
109                    IF(compareAliases(SA1, SA2)) GoTo 100
110                 ENDDO
111              ENDDO
112           ENDDO
113     ! Compare aliases between solids phases
114           DO M1 = 1, lMMx
115              DO N1 = 1, lNs(M1)
116                 SA1 = SA_s(M1,N1)
117                 IF(len_trim(SA1) == 0) CYCLE
118     ! Self phase comparison.
119                 M2 = M1
120                 DO N2=N1+1, lNs(M2)
121                    SA2 = SA_s(M2,N2)
122                    IF(len_trim(SA2) == 0) CYCLE
123                    IF(compareAliases(SA1, SA2)) GoTo 100
124                 ENDDO
125     ! Compare with other phases.
126                 DO M2 = M1+1, lMMx
127                    DO N2 = 1, lNs(M2)
128                       SA2 = SA_s(M2,N2)
129                       IF(len_trim(SA2) == 0) CYCLE
130                       IF(compareAliases(SA1, SA2)) GoTo 100
131                    ENDDO
132                 ENDDO
133              ENDDO
134           ENDDO
135     
136           CALL FINL_ERR_MSG
137           RETURN
138     
139       100 WRITE(ERR_MSG, 1100) M1, N1, SA1, M2, N2, SA2
140           CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
141     
142      1100 FORMAT('Error 1100: Non-unique species aliases detected.',/      &
143              3x,'Phase: ',I2,', Species: ',I3,' - Alias: ',A,/             &
144              3x,'Phase: ',I2,', Species: ',I3,' - Alias: ',A,//            &
145              'Please correct the mfix.dat file.')
146     
147           END SUBROUTINE checkDuplicateAliases
148     
149     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
150     !  Function name: checkSpeciesInc()                                    !
151     !                                                                      !
152     !  Purpose: Loop through the species.inc file and verify that the      !
153     !  match those provided in the datafile.                               !
154     !                                                                      !
155     !  Variables referenced: None                                          !
156     !                                                                      !
157     !  Variables modified: None                                            !
158     !                                                                      !
159     !  Local variables: None                                               !
160     !                                                                      !
161     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
162           SUBROUTINE checkSpeciesInc(lNg, SA_g, lMMx, lNs, SA_s,           &
163              lNRxn,  lRNames, lNRxn_DES, lRNames_DES)
164     
165           use run, only: REINITIALIZING
166           use error_manager
167           use toleranc
168           USE utilities, ONLY: blank_line, seek_comment
169     
170           IMPLICIT NONE
171     
172     ! Number of gas speices
173           INTEGER, INTENT(IN) :: lNg
174     ! Gas phase species aliases
175           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: SA_g
176     ! Number of solids phases
177           INTEGER, INTENT(IN) :: lMMx
178     ! Number of species in each solids phase.
179           INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
180     ! Solids phase speices aliases.
181           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: SA_s
182     ! Number of reactions
183           INTEGER, INTENT(IN) :: lNRxn
184     ! Reaction Names (aliases)
185           CHARACTER(len=32), INTENT(IN) ::  lRNames(DIMENSION_RXN)
186     ! Number of discrete reactions
187           INTEGER, INTENT(IN) :: lNRxn_DES
188     ! Reaction Names for discrete solids (aliases)
189           CHARACTER(len=32), INTENT(IN) ::  lRNames_DES(DIMENSION_RXN)
190     
191     ! Input/Output status.
192           INTEGER :: IOS
193     ! File unit.
194           INTEGER, PARAMETER :: FUNIT = 167
195     ! Full path to Burcat and Ruscic database
196           CHARACTER(len=255) :: FILENAME
197           CHARACTER(len=128) :: INPUT
198     ! Loop counters
199           INTEGER :: SRC, M
200     ! Position of interest in string.
201           INTEGER :: POS
202     ! Index from species.inc file.
203           INTEGER :: lIndex
204           CHARACTER(len=64) :: lName
205           CHARACTER(len=32) :: tName
206     ! Length of noncomment string
207           INTEGER :: LINE_LEN
208     
209           CALL INIT_ERR_MSG("RXN_COM --> checkDuplicateAliases")
210     
211           SRC = 0
212     
213     ! Loop over possible locations .
214           SRC_LP: DO
215              SRC = SRC + 1
216              SELECT CASE(SRC)
217     
218     ! Check the local run directory.
219              CASE(1); FILENAME = 'species.inc'
220                 OPEN(CONVERT='BIG_ENDIAN',UNIT=FUNIT,FILE=trim(FILENAME),STATUS='OLD',IOSTAT=IOS)
221                 IF(IOS /= 0) CYCLE SRC_LP
222                 IF(.NOT.REINITIALIZING)THEN
223                    WRITE(ERR_MSG, 1000)'species.inc'
224                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
225                 ENDIF
226     
227      1000 FORMAT(/2X,'Verifying reaction aliases in ',A)
228     
229     ! No species.inc file was located.
230              CASE DEFAULT
231                 IF(.NOT.REINITIALIZING)THEN
232                    WRITE(ERR_MSG, 1004)
233                    CALL FLUSH_ERR_MSG
234                 ENDIF
235                 EXIT SRC_LP
236              END SELECT
237     
238      1004 FORMAT('Warning 1004: Unable to locate the species.inc file. No ',&
239              'verification',/'of mfix.dat species aliases or reaction ',    &
240              'names can be preformed.')
241     
242              REWIND(FUNIT)
243              READ_LP: DO
244                 READ(FUNIT,"(A)",IOSTAT=IOS) INPUT
245     
246     ! This is a sanity check because the species.inc file is generated by
247     ! make_mfix and therefore should be the correct format.
248                 IF(IOS > 0) THEN
249                    WRITE(ERR_MSG,1200) trim(adjustl(FILENAME))
250                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
251      1200 FORMAT('Error 1200: There was a problem reading file: ',A)
252     
253     ! All entries have been processed.
254                 ELSEIF(IOS<0)THEN
255                    EXIT SRC_LP
256                 ENDIF
257     
258     ! Clean up the input.
259                 LINE_LEN = SEEK_COMMENT(INPUT,LEN(INPUT)) - 1
260                 CALL REMOVE_COMMENT(INPUT, LINE_LEN + 1, LEN(INPUT))
261                 CALL MAKE_UPPER_CASE(INPUT, LINE_LEN)
262                 CALL REPLACE_TAB(INPUT, LINE_LEN)
263     
264     ! Skip empty entires.
265                 IF(LINE_LEN <= 0) CYCLE READ_LP
266                 IF(BLANK_LINE(INPUT)) CYCLE READ_LP
267     
268                 POS = INDEX(INPUT,"INTEGER, PARAMETER ::")
269                 IF(POS /= 0) THEN
270                    INPUT = INPUT((POS + 21):)
271                 ELSE
272                    CYCLE READ_LP
273                 ENDIF
274     
275     ! We only want to process lines that have = as the other are coments.
276                 POS = INDEX(INPUT,"=")
277                 IF(POS == 0) CYCLE READ_LP
278     
279     ! Store the species alias.
280                 WRITE(lName,"(A)") trim(adjustl(INPUT(:(POS-1))))
281     
282     ! Convert the read index from string to integer. Report any errors.
283                 READ(INPUT((POS+1):),*,IOSTAT=IOS) lIndex
284                 IF(IOS /= 0) THEN
285                    WRITE(ERR_MSG,1205) 'index', trim(INPUT)
286                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
287                 ENDIF
288     
289      1205 FORMAT('Error 1205: Unable to obtain alias index from species.', &
290              'inc file.',//' INPUT: ',A)
291     
292     ! Match against what was provided in the datafile:
293     ! Gas phase species aliases.
294                 IF(lIndex <= lNg) THEN
295                    tName = SA_g(lIndex)
296                    IF(compareAliases(tName, lName)) CYCLE READ_LP
297                 ENDIF
298     
299     ! Solids phase species aliases.
300                 DO M = 1, lMMx
301                    IF(lIndex <= lNs(M))THEN
302                       tName = SA_s(M, lIndex)
303                       IF(compareAliases(tName, lName)) CYCLE READ_LP
304                    ENDIF
305                 ENDDO
306     
307     ! Reaction Names
308                 IF(lIndex <= lNRxn)THEN
309                    tName =  lRNames(lIndex)
310                    IF(compareAliases(tName, lName)) CYCLE READ_LP
311                 ENDIF
312     
313     ! Reaction Names for discrete solids
314                 IF(lIndex <= lNRxn_DES)THEN
315                    tName =  lRNames_DES(lIndex)
316                    IF(compareAliases(tName, lName)) CYCLE READ_LP
317                 ENDIF
318     
319                 WRITE(ERR_MSG,1300) trim(lName), lIndex
320                 CALL FLUSH_ERR_MSG
321     
322      1300 FORMAT('Error 1300: An entry in the species.inc file does not ', &
323              'match any inputs',/'in the mfix.dat file.'/3x,'Name: ',A,4x, &
324              'Index: ',I3,/'If the quantity or order of gas species, ',    &
325              'solids species, or chemical',/'reactions has changed, then ',&
326              'the executable must be re-build. Please',/'see the document',&
327              'ation for specifying chemical reactions.')
328     
329              ENDDO READ_LP
330           ENDDO SRC_LP
331     
332           CLOSE(FUNIT)
333           CALL FINL_ERR_MSG
334           RETURN
335     
336           END SUBROUTINE checkSpeciesInc
337     
338     
339     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
340     !  Function name: compareAlaises()                                     !
341     !                                                                      !
342     !  Purpose:                                                            !
343     !                                                                      !
344     !  Variables referenced: None                                          !
345     !                                                                      !
346     !  Variables modified: None                                            !
347     !                                                                      !
348     !  Local variables: None                                               !
349     !                                                                      !
350     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
351           LOGICAL FUNCTION compareAliases(lS1, lS2, N1, N2)
352     
353           IMPLICIT NONE
354     
355           CHARACTER(len=*), INTENT(IN) :: lS1, lS2
356     
357           INTEGER, OPTIONAL, INTENT(IN) :: N1, N2
358     
359           CALL MAKE_UPPER_CASE (lS1, len(lS1))
360           CALL MAKE_UPPER_CASE (lS2, len(lS2))
361     
362           compareAliases = .FALSE.
363           IF(trim(lS1) == trim(lS2)) compareAliases = .TRUE.
364     
365           IF(.NOT.compareAliases) RETURN
366     
367           IF(PRESENT(N1) .AND. PRESENT(N2)) THEN
368              IF(N1 == N2) THEN
369                 compareAliases = .TRUE.
370              ELSE
371                 compareAliases = .FALSE.
372              ENDIF
373           ENDIF
374     
375           RETURN
376           END FUNCTION compareAliases
377     
378     
379     
380     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
381     !  Subroutine: WRITE_RXN_SUMMARY                                       !
382     !                                                                      !
383     !  Purpose:                                                            !
384     !                                                                      !
385     !  Variables referenced: None                                          !
386     !                                                                      !
387     !  Variables modified: None                                            !
388     !                                                                      !
389     !  Local variables: None                                               !
390     !                                                                      !
391     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
392           SUBROUTINE WRITE_RXN_SUMMARY(RxN, lSAg, lSAs, ABORT, fUNIT)
393     
394           USE toleranc
395     
396           IMPLICIT NONE
397     
398     ! Data structure for storing reaction data.
399           TYPE(REACTION_BLOCK), POINTER, INTENT(IN) :: RxN
400     
401     ! Gas phase species aliases
402           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
403     ! Solids phase speices aliases.
404           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
405     ! Flag to abort the run.
406           LOGICAL, INTENT(IN) :: ABORT
407     
408     ! Optional file unit.
409           INTEGER, OPTIONAL :: fUNIT
410     
411           CHARACTER(LEN=72) :: OUTPUT, full, divided, empty
412     
413           CHARACTER(LEN=32) :: lSP
414     
415           INTEGER lN, M, N
416           INTEGER lS, lE
417     
418           INTEGER UNIT_FLAG
419     
420           IF(present(fUnit)) THEN
421              UNIT_FLAG = fUNIT
422           ELSE
423              UNIT_FLAG = -1
424           ENDIF
425     
426           empty = '  '
427           CALL WRITE_RS0(empty, UNIT_FLAG)
428     
429           full = ''
430           WRITE(full,2000)
431     
432           divided = ''
433           WRITE(divided,2005)
434     
435     ! Lead bar
436           CALL WRITE_RS0(full, UNIT_FLAG)
437     ! Reaction Nmae
438           OUTPUT = ''
439           WRITE(OUTPUT, 2001)trim(RxN%Name)
440           OUTPUT(72:72) = '|'
441           CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
442     
443     ! Row Divider
444           CALL WRITE_RS0(full, UNIT_FLAG)
445     
446           OUTPUT = ''
447           WRITE(OUTPUT, 2002)trim(RxN%ChemEq(1:54))
448           OUTPUT(72:72) = '|'
449           CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
450     
451           CALL WRITE_RS0(full, UNIT_FLAG)
452     
453           IF(RxN%nSpecies > 0) THEN
454     
455              OUTPUT = ''
456              WRITE(OUTPUT, 2007)trim(RxN%Classification)
457              OUTPUT(72:72) = '|'
458              CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
459     ! Row Divider
460              CALL WRITE_RS0(full, UNIT_FLAG)
461     
462              WRITE(OUTPUT,2003); CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
463              WRITE(OUTPUT,2004); CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
464              CALL WRITE_RS0(divided, UNIT_FLAG)
465           ENDIF
466     
467     
468           DO lN = 1, RxN%nSpecies
469     
470              M = RxN%Species(lN)%pMap
471              N = RxN%Species(lN)%sMap
472     
473              WRITE(OUTPUT,2006)
474     
475              IF(M == 0) THEN
476                 IF(len_trim(lSAg(N)) > 8) THEN
477                    lSP = lSAg(N)
478                    OUTPUT(5:13) = lSP(1:8)
479                 ELSE
480                   lS = (9-int(len_trim(lSAg(N))/2))
481                   lE = lS + len_trim(lSAg(N))
482                    OUTPUT(lS:lE) = trim(lSAg(N))
483                 ENDIF
484                 WRITE(OUTPUT(32:35),"(A)") 'Gas'
485              ELSE
486                 IF(len_trim(lSAs(M,N)) > 8) THEN
487                    lSP = lSAs(M,N)
488                    OUTPUT(5:13) = lSP(1:8)
489                 ELSE
490                    lS = (9-int(len_trim(lSAs(M,N))/2))
491                    lE = lS + len_trim(lSAs(M,N))
492                    OUTPUT(lS:lE) = trim(lSAs(M,N))
493                 ENDIF
494                 WRITE(OUTPUT(30:36),"(A,I2)") 'Solid',M
495              ENDIF
496              WRITE(OUTPUT(43:44),"(I2)") N
497              WRITE(OUTPUT(51:60),"(F9.4)") RxN%Species(lN)%MW
498     
499              IF(COMPARE(RxN%Species(lN)%Coeff, ZERO)) THEN
500                 WRITE(OUTPUT(17:26),"(F9.4)") ZERO
501                 WRITE(OUTPUT(63:71),"(A)") 'Catalyst'
502              ELSEIF(RxN%Species(lN)%Coeff < ZERO) THEN
503                 WRITE(OUTPUT(17:26),"(F9.4)") -RxN%Species(lN)%Coeff
504                 WRITE(OUTPUT(63:71),"(A)") 'Reactant'
505              ELSE
506                 WRITE(OUTPUT(17:26),"(F9.4)")  RxN%Species(lN)%Coeff
507                 WRITE(OUTPUT(63:70),"(A)") 'Product'
508              ENDIF
509              CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
510              CALL WRITE_RS0(divided, UNIT_FLAG)
511     
512           ENDDO
513     
514           CALL WRITE_RS0(empty, UNIT_FLAG)
515     
516           IF(ABORT) CALL MFIX_EXIT(myPE)
517           RETURN
518     
519     
520      2000 FORMAT(2X,'|',68('-'),'|')
521     
522      2001 FORMAT(2X,'| Name: ',A)
523      2002 FORMAT(2x,'| Chemical Eq: ',A)
524     
525      2003 FORMAT('  | Species  |   Stoich    |         | Species |',       &
526                   ' Molecular  |          |')
527     
528      2004 FORMAT('  |  Alias   |   Coeff.    |  Phase  |  Index  |',       &
529                   '   Weight   |   Type   |')
530     
531     
532      2005 FORMAT(2X,'|',10('-'),'|',13('-'),'|',9('-'),'|',9('-'),'|',     &
533                  12('-'),'|',10('-'),'|')
534     
535      2006 FORMAT(2X,'|',10(' '),'|',13(' '),'|',9(' '),'|',9(' '),'|',     &
536                  12(' '),'|',10(' '),'|')
537     
538     
539      2007 FORMAT(2X,'| Classification: ',A)
540     
541           contains
542     
543     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
544     !  Subroutine: WRITE_RS0                                               !
545     !                                                                      !
546     !  Purpose:                                                            !
547     !                                                                      !
548     !  Variables referenced: None                                          !
549     !                                                                      !
550     !  Variables modified: None                                            !
551     !                                                                      !
552     !  Local variables: None                                               !
553     !                                                                      !
554     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
555           SUBROUTINE WRITE_RS0(LINE, UFLAG)
556     
557           use run, only: REINITIALIZING
558           use error_manager
559     
560           IMPLICIT NONE
561     
562           CHARACTER(len=*), INTENT(IN) :: LINE
563           INTEGER, INTENT(IN) :: UFLAG
564     
565           CALL INIT_ERR_MSG("WRITE_RXN_SUMMARY --> WRITE_RS0")
566     
567           IF(UFLAG == -1)THEN
568              IF(.NOT.REINITIALIZING) THEN
569                 WRITE(ERR_MSG,*) LINE
570                 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
571              ENDIF
572           ELSE
573              WRITE(UFLAG,*) LINE
574           ENDIF
575           CALL FINL_ERR_MSG
576     
577           RETURN
578           END SUBROUTINE WRITE_RS0
579           END SUBROUTINE WRITE_RXN_SUMMARY
580     
581     
582     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
583     !  Subroutine: checkThermoReqs                                         !
584     !                                                                      !
585     !  Purpose:                                                            !
586     !                                                                      !
587     !  Variables referenced: None                                          !
588     !                                                                      !
589     !  Variables modified: None                                            !
590     !                                                                      !
591     !  Local variables: None                                               !
592     !                                                                      !
593     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
594           SUBROUTINE checkThermoReqs(RxN, S_g, S_s, rDB, MWg, MWs, Cpg0, Cps0)
595     
596           use error_manager
597           use toleranc
598     
599           IMPLICIT NONE
600     
601     ! Data structure for storing reaction data.
602           TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
603     
604           CHARACTER(len=18), INTENT(IN) :: S_g(DIM_N_g)
605           CHARACTER(len=18), INTENT(in) :: S_s(DIM_M, DIM_N_s)
606           LOGICAL, INTENT(inout) :: rDB(0:DIM_M, DIM_N_g)
607           DOUBLE PRECISION, INTENT(in) :: Cpg0
608           DOUBLE PRECISION, INTENT(in) :: Cps0(DIM_M)
609           DOUBLE PRECISION, INTENT(inout) :: MWg(DIM_N_g)
610           DOUBLE PRECISION, INTENT(inout) :: MWs(DIM_M, DIM_N_s)
611     
612           LOGICAL :: CP_FATAL
613           LOGICAL :: CHECK_DATABASE
614     
615           INTEGER :: M, N, lN
616     
617     
618           CALL INIT_ERR_MSG("RXN_COM --> checkThermoReqs")
619     
620           CHECK_DATABASE = .FALSE.
621           CP_FATAL = .FALSE.
622     
623     ! Verify that the molecular weights and stoichiometry are consistent and
624     ! determine interphase mass exchanges.
625           DO lN = 1, RxN%nSpecies
626              M = RxN%Species(lN)%pMap
627              N = RxN%Species(lN)%sMap
628              IF(M == 0) THEN
629                 IF(Cpg0 /= UNDEFINED) THEN
630                    CP_FATAL = .TRUE.
631                 ELSEIF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
632                    (MWg(N) == UNDEFINED)) THEN
633                    CHECK_DATABASE = .TRUE.
634                 ENDIF
635              ELSE
636                 IF(Cps0(M) /= UNDEFINED) THEN
637                    CP_FATAL = .TRUE.
638                 ELSEIF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
639                    (MWs(M,N) == UNDEFINED)) THEN
640                    CHECK_DATABASE = .TRUE.
641                 ENDIF
642              ENDIF
643           ENDDO
644     
645     ! Report errors and messages.
646           IF(CP_FATAL) THEN
647     
648              WRITE(ERR_MSG, 1100) trim(RxN%Name)
649              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
650     
651      1100 FORMAT('Error 1100: One or more phases associated with ',        &
652              'reaction ',A,/'has specified constant specific heat (C_PG0/',&
653              'Cps0). This is',/'not permitted for reacting phases. ',     &
654              'Please correct the mfix.dat file.')
655     
656           ELSEIF(CHECK_DATABASE) THEN
657     
658              WRITE(ERR_MSG, 1101) trim(RxN%Name)
659              CALL FLUSH_ERR_MSG
660     
661      1101 FORMAT('Message 1101: One or more molecular weights and/or ',    &
662              'thermochemical data',/'is needed for reaction ',A,'. The ',  &
663              'thermochemical database',/'will be used to gather the ',     &
664              'necessary data.')
665     
666           ENDIF
667     
668           IF(CHECK_DATABASE) THEN
669              WRITE(ERR_MSG, 1200)
670              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
671           ENDIF
672     
673      1200 FORMAT('Message 1200: Searching thermochemical databases for ',&
674              'species data.',/'  ')
675     
676           DO lN = 1, RxN%nSpecies
677              M = RxN%Species(lN)%pMap
678              N = RxN%Species(lN)%sMap
679              IF(M == 0) THEN
680                 IF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.         &
681                    (MWg(N) == UNDEFINED)) THEN
682     ! Notify the user of the reason the thermochemical database is used.
683     ! Flag that the species name is not provided.
684                    IF(S_g(N) == UNDEFINED_C) THEN
685                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_g',N))
686                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
687                    ENDIF
688     
689     ! Update the log files.
690                    WRITE(ERR_MSG, 3001) N, trim(S_g(N))
691                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
692     ! Read the database.
693                    CALL READ_DATABASE(0, N, S_g(N), MWg(N))
694     ! Flag variable to stating that the database was read.
695                    rDB(0,N) = .TRUE.
696                 ENDIF
697                 RxN%Species(lN)%MW = MWg(N)
698              ELSE
699                 IF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
700                    (MWs(M,N) == UNDEFINED)) THEN
701     
702     ! Flag that the species name is not provided.
703                    IF(S_s(M,N) == UNDEFINED_C) THEN
704                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_s',M,N))
705                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
706                    ENDIF
707     ! Update the log files.
708                    WRITE(ERR_MSG, 3001) N, trim(S_s(M,N))
709                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
710                    CALL READ_DATABASE(M,N,S_s(M,N),MWs(M,N))
711     ! Flag variable to stating that the database was read.
712                    rDB(M,N) = .TRUE.
713                 ENDIF
714                 RxN%Species(lN)%MW = MWs(M,N)
715              ENDIF
716           ENDDO
717     ! Finalize the error message.
718           IF(CHECK_DATABASE) CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
719     
720      3001 FORMAT(/2x,'>',I3,': Species: ',A)
721     
722           CALL FINL_ERR_MSG
723     
724           RETURN
725     
726      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
727                 'correct the mfix.dat file.')
728     
729           END SUBROUTINE checkThermoReqs
730     
731     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
732     !  Subroutine: checkMassBalance                                        !
733     !                                                                      !
734     !  Purpose:                                                            !
735     !                                                                      !
736     !  Variables referenced: None                                          !
737     !                                                                      !
738     !  Variables modified: None                                            !
739     !                                                                      !
740     !  Local variables: None                                               !
741     !                                                                      !
742     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
743           SUBROUTINE checkMassBalance(CALLER, RxN, lnMT, IER)
744     
745           USE toleranc
746     
747           IMPLICIT NONE
748     
749           CHARACTER(len=*), INTENT(IN) :: CALLER
750     
751     ! Data structure for storing reaction data.
752           TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
753     
754           DOUBLE PRECISION, INTENT(OUT) :: lnMT(0:DIM_M)
755           INTEGER, INTENT(OUT) :: IER
756     
757           INTEGER M, N, lN ! Phase, Species
758           DOUBLE PRECISION rSUM, pSUM
759           DOUBLE PRECISION MWxStoich
760     
761           INTEGER sprCount, sprIndex
762     
763           DOUBLE PRECISION, PARAMETER :: massBalanceTol = 1.0d-3
764     
765     ! Initialize variables
766           IER = 0
767           rSUM = ZERO
768           pSUM = ZERO
769           lnMT(:) = ZERO
770           sprCount = 0
771     
772     ! Verify that the molecular weights and stoichiometry are consistent and
773     ! determine interphase mass exchanges.
774           DO lN = 1, RxN%nSpecies
775              M = RxN%Species(lN)%pMap
776              N = RxN%Species(lN)%sMap
777     
778     ! Multiply the molecular weight and stoichiometric coefficient.
779              MWxStoich = RxN%Species(lN)%MW * RxN%Species(lN)%Coeff
780              RxN%Species(lN)%MWxStoich = MWxStoich
781     ! Calculate the net mass transfer for phase M.
782     !  0 : no interphase mass transfder
783     ! >0 : gains mass from anther phase
784     ! <0 : transfers mass to anther phase
785              lnMT(M) = lnMT(M) + MWxStoich
786     ! Calculate mass of reactants and products. Used to ensure mass balance.
787              IF(MWxStoich < ZERO) THEN
788                 rSUM = rSUM - MWxStoich
789                 IF(M /= 0) THEN
790                    sprCount = sprCount + 1
791                    IF(sprCount == 1) THEN
792                       sprIndex = M
793     ! Verify that there is at most one solids phase fule (reactant).
794                    ELSEIF( M /= sprIndex) THEN
795                       IF(DMP_LOG) THEN
796                          WRITE(*,1002) trim(CALLER), trim(RxN%Name)
797                          WRITE(UNIT_LOG,1002) trim(CALLER), trim(RxN%Name)
798                          IER = 1
799                       ENDIF
800                    ENDIF
801                 ENDIF
802              ELSE
803                 pSUM = pSUM + MWxStoich
804              ENDIF
805           ENDDO
806     ! Verify that the mass of products equals reactants: (Mass Balance)
807           IF (.NOT.COMPARE(rSUM,pSUM)) THEN
808              IF(DMP_LOG) THEN
809                 WRITE(*,1001) trim(CALLER), trim(RxN%Name), rSUM, pSUM
810                 WRITE(UNIT_LOG,1001) trim(CALLER), trim(RxN%Name), rSUM,pSUM
811                 IER = 1
812              ENDIF
813           ENDIF
814     
815           RETURN
816     
817     ! Error Messages
818     !---------------------------------------------------------------------//
819     
820      1001 FORMAT(/1X,70('*')/' From: ',A,' --> RXN_COM -->',               &
821              ' checkMassBalance',/' Error 1001: Stoichiometry is not',     &
822              ' consistent with molecular weights',/' for reaction ',A,'.',/&
823              ' Mass of reactants: ',F12.4,/' Mass of products:  ',F12.4,/  &
824              1X,70('*')/)
825     
826      1002 FORMAT(/1X,70('*')/' From: ',A,' --> RXN_COM -->',               &
827              ' checkMassBalance',/' Error 1002: More than one solids',     &
828              ' phase fules was detected. Unable to',/' determine solids/', &
829              'solids heat of reaction unambiguously for',/' reaction ',A,  &
830              '.',/1X,70('*')/)
831     
832           END SUBROUTINE checkMassBalance
833     
834     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
835     !  Subroutine: calcInterphaseTxfr                                      !
836     !                                                                      !
837     !  Purpose:                                                            !
838     !                                                                      !
839     !  Variables referenced: None                                          !
840     !                                                                      !
841     !  Variables modified: None                                            !
842     !                                                                      !
843     !  Local variables: None                                               !
844     !                                                                      !
845     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
846           SUBROUTINE calcInterphaseTxfr(CALLER, RxN, lnMT, lEEq, lSEq, &
847              lSAg, lMMx, lSAs)
848     
849              USE exit, only: mfix_exit
850              USE toleranc
851     
852           IMPLICIT NONE
853     
854           CHARACTER(len=*), INTENT(IN) :: CALLER
855     
856     ! Data structure for storing reaction data.
857           TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
858     
859           DOUBLE PRECISION, INTENT(IN) :: lnMT(0:DIM_M)
860     ! Energy equation flag
861           LOGICAL, INTENT(IN) :: lEEq
862     ! Gas/Solids Species Eq Flag
863           LOGICAL, INTENT(IN) :: lSEq(0:DIM_M)
864     ! Gas phase species aliases
865           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
866     ! Number of solids phases
867           INTEGER, INTENT(IN) :: lMMx
868     ! Solids phase speices aliases.
869           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
870     
871           INTEGER toPhase, toPhaseCount, mCount
872           INTEGER fromPhase, fromPhaseCount
873           INTEGER catPhase
874     
875           INTEGER M, MM, LL
876           INTEGER lM, lN
877     
878           DOUBLE PRECISION, PARAMETER :: massBalanceTol = 1.0d-3
879     
880     ! Initialize interphase exchange terms.
881           IF(Allocated(RxN%rPhase)) RxN%rPhase(:) = ZERO
882     
883     ! If there is only one phase referenced by the reaction, there there
884     ! should be no interphase mass transfer.
885           IF(RxN%nPhases == 1) THEN
886     ! Interphase mass transfer is set to zero. Small inconsistencies with
887     ! molecular weights can result in a non-zero value for homogeneous
888     ! reactions. Presumably, the mass balance check caught any major errors.
889              RxN%rPhase(:) = ZERO
890     ! Void interphase transfer flags.
891              DO lN = 1, RxN%nSpecies
892                 M = RxN%Species(lN)%pMap
893                 RxN%Species(lN)%mXfr = M
894              ENDDO
895              RxN%Classification = "Homogeneous"
896     ! This is a multiphase reaction.
897           ELSE
898     ! Initialize.
899              toPhaseCount = 0
900              fromPhaseCount = 0
901              DO M = 0, lMMx
902     ! Determine the number of phases with a net mass gain. Record the index
903     ! of the last phase with a net mass gain.
904                 IF (lnMT(M) > massBalanceTol) THEN
905                    toPhaseCount = toPhaseCount + 1
906                    toPhase = M
907     ! Determine the number of phases with a net mass loss. Record the index
908     ! index of the last phase with a net mass loss.
909                 ELSEIF(lnMT(M) < -massBalanceTol) THEN
910                    fromPhaseCount = fromPhaseCount + 1
911                    fromPhase = M
912                 ENDIF
913              ENDDO
914     
915     ! Only one phase has a net mass gain.
916              IF(toPhaseCount == 1) THEN
917     ! Interphase mass transfer flag.
918                 RxN%Classification = "Heterogeneous"
919                 DO M = 0, lMMx
920                    IF(M /= toPhase) THEN
921                       IF (toPhase < M) THEN
922                          LM = 1 + toPhase + ((M-1)*M)/2
923                          RxN%rPhase(LM) = -lnMT(M)
924                       ELSE
925                          LM = 1 + M + ((toPhase-1)*toPhase)/2
926                          RxN%rPhase(LM) = lnMT(M)
927                       ENDIF
928     
929     ! Verify that if one phase's species equations are solved, that the
930     ! other phase's species equations are solved.
931     
932                       IF(abs(RxN%rPhase(LM)) > SMALL_NUMBER) THEN
933                          IF((lSEq(toPhase) .AND. .NOT.lSEq(M)) .OR. &
934                             (.NOT.lSEq(toPhase) .AND. lSEq(M))) THEN
935                             IF(DMP_LOG) THEN
936                                WRITE(*,1001) trim(CALLER)
937                                WRITE(UNIT_LOG,1001) trim(CALLER)
938                                IF(lSEq(M)) THEN
939                                   WRITE(*,1101) M, 'Solving'
940                                   WRITE(*,1101) toPhase, 'Not Solving'
941                                   WRITE(UNIT_LOG,1101) M, 'Solving'
942                                   WRITE(UNIT_LOG,1101) toPhase, &
943                                      'Not Solving'
944                                ELSE
945                                   WRITE(*,1101) toPhase, 'Solving'
946                                   WRITE(*,1101) M, 'Not Solving'
947                                   WRITE(UNIT_LOG,1101) M, 'Solving'
948                                   WRITE(UNIT_LOG,1101) toPhase, &
949                                      'Not Solving'
950                                ENDIF
951                                WRITE(*,1000)
952                                WRITE(UNIT_LOG,1000)
953                             ENDIF
954                             CALL WRITE_RXN_SUMMARY(RxN, lSAg(:),           &
955                                lSAs(:,:), .TRUE.)
956                          ENDIF
957                       ENDIF
958                    ENDIF
959                 ENDDO
960     
961     ! Set flags for enthalpy transfer associated with mass transfer.
962                 IF(lEEq .AND. RxN%Calc_DH) THEN
963                    DO lN = 1, RxN%nSpecies
964                       M = RxN%Species(lN)%pMap
965     ! The gas phase is referenced by the reaction.
966                       IF(M == 0) THEN
967     ! The gas phase is the destination phase.
968                          IF(toPhase == 0) THEN
969     ! Counter for the number of solids phases transfering mass to the
970     ! gas phase.
971                             mCount = 0
972     ! Check to see if phase M transfer mass to another solids phase.
973                             DO MM = 1, lMMx
974                                LM = 1 + (MM-1)*MM/2
975     ! Mass transfer occurs between the gas and solids phase MM.
976                                IF(RxN%rPhase(LM) > 0) THEN
977     ! Indicate that phase MM receives mass from phase M.
978                                   RxN%Species(lN)%mXfr = MM
979     ! The fraction of material transfered from phase 0 to phase MM.
980     ! This variable is not currently used for gas/solids reactions.
981                                   RxN%Species(lN)%xXfr = ZERO
982     ! Increment the number of phases the gas receives mass from.
983                                   mCount = mCount + 1
984                                ENDIF
985                             ENDDO
986                             IF(mCount /= 1) THEN
987                                IF(DMP_LOG) THEN
988                                   WRITE(*,1002) trim(CALLER), &
989                                      trim(RxN%ChemEq)
990                                   WRITE(*,1000)
991                                   WRITE(UNIT_LOG,1002) trim(CALLER), &
992                                      trim(RxN%ChemEq)
993                                   WRITE(UNIT_LOG,1000)
994                                ENDIF
995                                CALL WRITE_RXN_SUMMARY(RxN, lSAg(:), &
996                                   lSAs(:,:), .TRUE.)
997                             ENDIF
998     
999     ! A solids phase is the destination phase.
1000                          ELSE
1001     ! Since only one phase was detected with a net mass gain and the gas
1002     ! phase was detected as a source phase, then all the gas is assigned
1003     ! to the destination phase.
1004                             RxN%Species(lN)%mXfr = toPhase
1005     ! This variable is not used for gas/solids reactions.
1006                             RxN%Species(lN)%xXfr = ZERO
1007                          ENDIF
1008     ! Solids/Solids mass transfer: Enthalpy transfer from mass transfer is
1009     ! only calculated from source phase reactants.
1010                       ELSE
1011     ! Check to see if phase M transfer mass to another solids phase.
1012                          DO LL = 1, lMMx-1
1013                             DO MM = LL + 1, lMMx
1014                                IF(M /= LL .AND. M /= MM) CYCLE
1015                                LM = LL + 1 + (MM-1)*MM/2
1016                                IF(RxN%rPhase(LM) == ZERO) CYCLE
1017     ! Mass transfer occurs between solids phases M and MM, and phase M
1018     ! is the source phase.
1019                                IF( M == LL .AND. &
1020                                   RxN%rPhase(LM) < ZERO) THEN
1021     ! Indicate that phase MM receives mass from phase M.
1022                                   RxN%Species(lN)%mXfr = MM
1023     ! Calculate the fraction of material consumed from phase M is transfered
1024     ! to phase MM.
1025                                   RxN%Species(lN)%xXfr =  &
1026                                      abs(lnMT(MM) / lnMT(LL))
1027     ! Mass transfer occurs between solids phases M and LL, and phase M
1028     ! is the source phase.
1029                                ELSEIF( M == MM .AND. &
1030                                   RxN%rPhase(LM) > ZERO) THEN
1031     ! Indicate that phase LL receives mass from phase M.
1032                                   RxN%Species(lN)%mXfr = LL
1033     ! Calculate the fraction of material consumed from phase M is transfered
1034     ! to phase LL.
1035                                   RxN%Species(lN)%xXfr = &
1036                                      abs(lnMT(LL) / lnMT(MM))
1037                                ENDIF
1038                             ENDDO
1039                          ENDDO
1040                       ENDIF ! Gas or Solids phase.
1041                    ENDDO ! Species Loop
1042                 ENDIF ! Energy Equation
1043     ! If there is only one phase with a net mass loss, setup the array for
1044     ! interphase mass transfer.
1045              ELSEIF(fromPhaseCount == 1) THEN
1046                 RxN%Classification = "Heterogeneous"
1047                 DO M = 0, lMMx
1048                    IF (M /= fromPhase) THEN
1049                       IF(M < fromPhase) THEN
1050                          LM = 1 + M + ((fromPhase-1)*fromPhase)/2
1051                          RxN%rPhase(LM) =  lnMT(M)
1052                       ELSE
1053                          LM = 1 + fromPhase + ((M-1)*M)/2
1054                          RxN%rPhase(LM) = -lnMT(M)
1055                       ENDIF
1056     
1057     ! Verify that if one phase's species equations are solved, that the
1058     ! other phase's species equations are solved.
1059                       IF(abs(RxN%rPhase(LM)) > SMALL_NUMBER) THEN
1060                          IF((lSEq(fromPhase) .AND. .NOT.lSEq(M)) .OR.   &
1061                             (.NOT.lSEq(fromPhase) .AND. lSEq(M))) THEN
1062                             IF(DMP_LOG) THEN
1063                                WRITE(*,1001) trim(CALLER)
1064                                WRITE(UNIT_LOG,1001) trim(CALLER)
1065                                IF(lSEq(M)) THEN
1066                                   WRITE(*,1101) M, 'Solving'
1067                                   WRITE(*,1101) fromPhase, 'Not Solving'
1068                                   WRITE(UNIT_LOG,1101) M, 'Solving'
1069                                   WRITE(UNIT_LOG,1101) fromPhase, &
1070                                      'Not Solving'
1071                                ELSE
1072                                   WRITE(*,1101) toPhase, 'Solving'
1073                                   WRITE(*,1101) M, 'Not Solving'
1074                                   WRITE(UNIT_LOG,1101) fromPhase, 'Solving'
1075                                   WRITE(UNIT_LOG,1101) M, 'Not Solving'
1076                                ENDIF
1077                                WRITE(*,1000)
1078                                WRITE(UNIT_LOG,1000)
1079                             ENDIF
1080                             CALL WRITE_RXN_SUMMARY(RxN, lSAg(:),           &
1081                                lSAs(:,:), .TRUE.)
1082                          ENDIF
1083                       ENDIF
1084                    ENDIF
1085                 END DO
1086     
1087     ! Set flags for enthalpy transfer associated with mass transfer.
1088                 IF(lEEq .AND. RxN%Calc_DH) THEN
1089                    DO lN = 1, RxN%nSpecies
1090                       M = RxN%Species(lN)%pMap
1091     ! Gas/solids reaction: Enthalpy transfer from mass transfer is only
1092     ! calculated from gas phase species.
1093                       IF(M == 0) THEN
1094     ! Gas phase is the source phase.
1095                          IF(fromPhase == 0) THEN
1096     ! Counter for the number of solids phases transfering mass to the
1097     ! gas phase.
1098                             mCount = 0
1099     ! Check to see if phase M transfer mass to another solids phase.
1100                             DO MM = 1, lMMx
1101                                LM = 1 + (MM-1)*MM/2
1102     ! Mass transfer occurs between the gas and solids phases MM.
1103                                IF(RxN%rPhase(LM) < 0) THEN
1104     ! Indicate that phase MM receives mass from phase M.
1105                                   RxN%Species(lN)%mXfr = MM
1106     ! The fraction of material transfered from phase 0 to phase MM.
1107     ! This variable is not currently used for gas/solids reactions.
1108                                   RxN%Species(lN)%xXfr = ZERO
1109     ! Increment the number of phases the gas receives mass from.
1110                                   mCount = mCount + 1
1111                                ENDIF
1112                             ENDDO
1113                             IF(mCount /=1 ) THEN
1114                                IF(DMP_LOG) THEN
1115                                   WRITE(*,1002) trim(CALLER), &
1116                                      trim(RxN%ChemEq)
1117                                   WRITE(*,1000)
1118                                   WRITE(UNIT_LOG,1002) trim(CALLER), &
1119                                      trim(RxN%ChemEq)
1120                                   WRITE(UNIT_LOG,1000)
1121                                ENDIF
1122                                CALL WRITE_RXN_SUMMARY(RxN, lSAg(:),  &
1123                                   lSAs(:,:), .TRUE.)
1124                             ENDIF
1125                          ELSE
1126     ! There can be only one solids phase fuel. Store the phase of the
1127     ! solids phase reactant.
1128                             RxN%Species(lN)%mXfr = fromPhase
1129     ! Mass fraction of transfered material.
1130     ! This variable is not currently used for gas/solids reactions.
1131                             RxN%Species(lN)%xXfr = ZERO
1132                          ENDIF
1133     ! Solids/Solids mass transfer: Enthalpy transfer from mass transfer is
1134     ! only calculated from source phase reactants.
1135                       ELSE
1136     ! Check to see if phase M transfer mass to another solids phase.
1137                          DO LL = 1, lMMx-1
1138                             DO MM = LL + 1, lMMx
1139                                IF(M /= LL .AND. M /= MM) CYCLE
1140                                LM = LL + 1 + (MM-1)*MM/2
1141                                IF(RxN%rPhase(LM) == ZERO) CYCLE
1142     ! Mass transfer occurs between solids phases M and MM, and phase M
1143     ! is the source phase.
1144                                IF( M == LL .AND. &
1145                                   RxN%rPhase(LM) < ZERO) THEN
1146     ! Indicate that phase MM receives mass from phase M.
1147                                   RxN%Species(lN)%mXfr = MM
1148     ! Calculate the fraction of material consumed from phase M is transfered
1149     ! to phase MM.
1150                                   RxN%Species(lN)%xXfr = &
1151                                      abs(lnMT(MM) / lnMT(LL))
1152     ! Mass transfer occurs between solids phases M and LL, and phase M
1153     ! is the source phase.
1154                                ELSEIF( M == MM .AND. &
1155                                   RxN%rPhase(LM) > ZERO) THEN
1156     ! Indicate that phase LL receives mass from phase M.
1157                                   RxN%Species(lN)%mXfr = LL
1158     ! Calculate the fraction of material consumed from phase M is transfered
1159     ! to phase LL.
1160                                   RxN%Species(lN)%xXfr = &
1161                                      abs(lnMT(LL) / lnMT(MM))
1162                                ENDIF
1163                             ENDDO
1164                          ENDDO
1165                       ENDIF ! Gas or Solids phase.
1166                    ENDDO ! Species Loop
1167                 ENDIF ! Energy Equation
1168     
1169     ! If there are no phases with a net mass gain/loss, check to see if
1170     ! the reaction is turned off.
1171              ELSEIF(toPhaseCount == 0 .AND. fromPhaseCount == 0) THEN
1172     ! If the reaction is active, and there is no interphase mass transfer,
1173     ! classify the reaction as catalytic.
1174                 IF(RxN%nPhases > 0) RxN%Classification = "Catalytic"
1175                 RxN%rPhase(:)  = ZERO
1176     ! Set flags for enthalpy transfer associated with mass transfer.
1177                 IF(lEEq .AND. RxN%Calc_DH) THEN
1178     
1179     ! Identify the catalyst phase.
1180                    catPhase = -1
1181                    DO lN= 1, RxN%nSpecies
1182                       IF(COMPARE(RxN%Species(lN)%Coeff,ZERO)) THEN
1183                          IF(catPhase /= -1) THEN
1184                             IF(catPhase /= RxN%Species(lN)%pMap) THEN
1185                                IF(DMP_LOG) THEN
1186                                   WRITE(*,1002) trim(CALLER), &
1187                                      trim(RxN%Name)
1188                                   WRITE(*,1000)
1189                                   WRITE(UNIT_LOG,1002) trim(CALLER), &
1190                                      trim(RxN%Name)
1191                                   WRITE(UNIT_LOG,1000)
1192                                ENDIF
1193                                CALL WRITE_RXN_SUMMARY(RxN, lSAg(:),    &
1194                                   lSAs(:,:), .TRUE.)
1195                             ENDIF
1196                          ELSE
1197                             catPhase = RxN%Species(lN)%pMap
1198                          ENDIF
1199                       ENDIF
1200                    ENDDO
1201     ! Verify that a catalyst phase was found.
1202                    IF(catPhase == -1) THEN
1203                       IF(DMP_LOG) THEN
1204                          WRITE(*,1003) trim(CALLER), 'catalyst', &
1205                             trim(RxN%Name)
1206                          WRITE(*,1000)
1207                          WRITE(UNIT_LOG,1003) trim(CALLER), &
1208                             'catalyst', trim(RxN%Name)
1209                          WRITE(UNIT_LOG,1000)
1210                       ENDIF
1211                       CALL WRITE_RXN_SUMMARY(RxN, lSAg(:),                 &
1212                          lSAs(:,:), .TRUE.)
1213                    ENDIF
1214     
1215     ! Identify the reactant phase.
1216                    toPhase = -1
1217                    DO lN = 1, RxN%nSpecies
1218                       IF(.NOT.COMPARE(RxN%Species(lN)%Coeff,ZERO)) THEN
1219                          IF(toPhase /= -1) THEN
1220                             IF(toPhase /= RxN%Species(lN)%pMap) THEN
1221                                IF(DMP_LOG) THEN
1222                                   WRITE(*,1002) trim(CALLER), &
1223                                      trim(RxN%Name)
1224                                   WRITE(*,1000)
1225                                   WRITE(UNIT_LOG,1002) trim(CALLER), &
1226                                      trim(RxN%Name)
1227                                   WRITE(UNIT_LOG,1000)
1228                                ENDIF
1229                                CALL WRITE_RXN_SUMMARY(RxN, lSAg(:), &
1230                                   lSAs(:,:), .TRUE.)
1231                             ENDIF
1232                          ELSE
1233                             toPhase = RxN%Species(lN)%pMap
1234                          ENDIF
1235                       ENDIF
1236                    ENDDO
1237     ! Verify that a reacting phase was found.
1238                    IF(toPhase == -1) THEN
1239                       IF(DMP_LOG) THEN
1240                          WRITE(*,1003) trim(CALLER), 'reacting', &
1241                             trim(RxN%Name)
1242                          WRITE(*,1000)
1243                          WRITE(UNIT_LOG,1003) trim(CALLER), 'reacting', &
1244                             trim(RxN%Name)
1245                          WRITE(UNIT_LOG,1000)
1246                       ENDIF
1247                       CALL WRITE_RXN_SUMMARY(RxN, lSAg(:), lSAs(:,:),.TRUE.)
1248                    ENDIF
1249     
1250     ! Something when wrong.
1251                    IF(catPhase == toPhase) THEN
1252                       IF(DMP_LOG) THEN
1253                          WRITE(*,1004) trim(CALLER), trim(RxN%Name)
1254                          WRITE(*,1000)
1255                          WRITE(UNIT_LOG,1004) trim(CALLER),trim(RxN%Name)
1256                          WRITE(UNIT_LOG,1000)
1257                       ENDIF
1258                       CALL WRITE_RXN_SUMMARY(RxN, lSAg(:), lSAs(:,:),.TRUE.)
1259     !Gas/solid catalytic reaction:
1260                    ELSEIF(toPhase == 0) THEN
1261                       DO lN = 1, RxN%nSpecies
1262                          IF(RxN%Species(lN)%pMap == 0) THEN
1263     ! Indicate that phase MM receives mass from phase M.
1264                             RxN%Species(lN)%mXfr = catPhase
1265     ! The fraction of material transfered from phase 0 to phase MM.
1266     ! This variable is not currently used for gas/solids reactions.
1267                             RxN%Species(lN)%xXfr = ZERO
1268                          ENDIF
1269                       ENDDO
1270                    ELSEIF(catPhase == 0) THEN
1271                       DO lN = 1, RxN%nSpecies
1272                          IF(RxN%Species(lN)%pMap == 0) THEN
1273     ! Indicate that phase MM receives mass from phase M.
1274                             RxN%Species(lN)%mXfr = toPhase
1275     ! The fraction of material transfered from phase 0 to phase MM.
1276     ! This variable is not currently used for gas/solids reactions.
1277                             RxN%Species(lN)%xXfr = ZERO
1278                          ENDIF
1279                       ENDDO
1280                    ENDIF
1281                 ENDIF ! Energy Equation
1282              ELSE
1283     ! Two or more phases have a net mass loss and two or more phases have
1284     ! a net mass gain. Therefore, the interphase mass transfer cannot be
1285     ! concluded.
1286                 CALL WRITE_RXN_SUMMARY(RxN, lSAg(:), lSAs(:,:),.FALSE.)
1287                 WRITE(*,1002) trim(CALLER), trim(RxN%ChemEq)
1288                 WRITE(*,1000)
1289                 WRITE(UNIT_LOG,1002) trim(CALLER), trim(RxN%ChemEq)
1290                 WRITE(UNIT_LOG,1000)
1291                 CALL MFiX_EXIT(myPE)
1292              ENDIF
1293           ENDIF
1294     
1295           RETURN
1296     
1297     ! Error Messages
1298     !---------------------------------------------------------------------//
1299     
1300      1000 FORMAT(/' Please refer to the Readme file on the required input',&
1301              ' format and make',/' the necessary corrections to the data', &
1302              ' file.',/1X,70('*')//)
1303     
1304      1001 FORMAT(//1X,70('*')/' From: ',A,' --> RXN_COM -->',              &
1305              ' calcInterphaseTxfr',/' Error 1001: A chemical reaction or', &
1306              ' phase change was detected between',/' a phases solving',    &
1307              ' species equations and another phase not solving',/          &
1308              ' species equations.',/)
1309     
1310      1101 FORMAT(' Phase ',I2,': ',A,' species equations.')
1311     
1312      1002 FORMAT(//1X,70('*')/' From: ',A,' --> RXN_COM -->',              &
1313              ' calcInterphaseTxfr',/' Error 1002: Reaction complexity',    &
1314              ' exceeds implementation capabilities.',/' Unable to',        &
1315              ' determine unambiguously interphase heat or mass transfer.', &
1316              //' Reaction: ',A,//' Consider splitting the chemical',       &
1317              ' reaction equation into two or more',/' separate equations.',&
1318              ' The same reaction rate calculated in usr_rates',/' can be', &
1319              ' used for the multiple reactions to ensure mass')
1320     
1321      1003 FORMAT(//1X,70('*')/' From: ',A,' --> RXN_COM -->',              &
1322              ' calcInterphaseTxfr',/' Error 1003: Unable to determine ',A, &
1323              ' phase for catalytic reaction'/1X,A,'.')
1324     
1325      1004 FORMAT(//1X,70('*')/' From: ',A,' --> RXN_COM -->',              &
1326              ' calcInterphaseTxfr',/' Error 1004: Unable to distinguish',  &
1327              ' catalyst phase from reacting phase',/' for catalytic',      &
1328              ' reaction ',A,'.')
1329     
1330           END SUBROUTINE calcInterphaseTxfr
1331     
1332     
1333     END MODULE RXN_COM
1334