File: RELATIVE:/../../../mfix.git/model/rxn_com_mod.f

1           MODULE RXN_COM
2     
3           Use param
4           Use param1
5           USE compar
6           Use funits
7     
8     ! The following data types are used to group chemical reaction data.
9     !-----------------------------------------------------------------------
10     
11     ! Species belong to PHASE_ associated with a particular reaction.
12           TYPE SPECIES_
13     ! A link between the reacting species' arbitrary index and the
14     ! associated phase index in MFiX.
15              INTEGER pMap
16     ! A link between the reacting species' arbitrary index and the
17     ! associated species index in MFiX.
18              INTEGER sMap
19     ! Stoichiometric coefficient of the species from chemical equation.
20              DOUBLE PRECISION Coeff
21     ! Molecular weight
22              DOUBLE PRECISION MW
23     ! Fractional mass transfer
24              DOUBLE PRECISION xXfr
25     ! Index indicating enthalpy transfer associated with mass transfer.
26              INTEGER mXfr
27     ! Molecular weight of speices multiplying the stoichiometric coefficient
28              DOUBLE PRECISION MWxStoich
29           END TYPE SPECIES_
30     
31     ! Grouping of reaction information.
32           TYPE REACTION_BLOCK
33     ! Name of reaction construct from data file.
34              CHARACTER(LEN=32) :: Name
35     ! User defined chemical equation from data file.
36              CHARACTER(LEN=512) :: ChemEq
37     ! Reaction classification: Homogeneous, Heterogeneous, Catalytic.
38              CHARACTER(LEN=16) :: Classification
39     ! Indicates if the automated heat of reaction is to be calculated (T) or
40     ! if the user has supplied a heat of reaction (F).
41              LOGICAL Calc_DH
42     ! Number of phases associated with the reaction.
43              INTEGER nPhases
44     ! Number of species associated with the reaction.
45              INTEGER nSpecies
46     ! User-specified heat of reaction split among phases by fracDH
47              DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: HoR
48     ! Interphase mass transfer.
49              DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: rPhase
50     ! Reactant/Product information
51              TYPE(SPECIES_), DIMENSION(:), ALLOCATABLE :: Species
52     
53           END TYPE REACTION_BLOCK
54     
55           CONTAINS
56     
57     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
58     !  Subroutine: checkDuplicateAlaises                                   !
59     !                                                                      !
60     !  Purpose: Loop through species in all phases and ensure that no two  !
61     !  entries are the same. ***Warning*** Species aliases that were not   !
62     !  specified are skipped. Non-specified aliases are treated later in   !
63     !  parse_mod.f/mapAliases.                                             !
64     !                                                                      !
65     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
66           SUBROUTINE checkDuplicateAliases(lNg, SA_g, lMMx, lNs, SA_s)
67     
68           use error_manager
69     
70           IMPLICIT NONE
71     
72     ! Number of gas speices
73           INTEGER, INTENT(IN) :: lNg
74     ! Gas phase species aliases
75           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: SA_g
76     ! Number of solids phases
77           INTEGER, INTENT(IN) :: lMMx
78     ! Number of species in each solids phase.
79           INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
80     ! Solids phase speices aliases.
81           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: SA_s
82     
83     ! Loop indices.
84           INTEGER M1, N1  ! Phase, Species
85           INTEGER M2, N2  ! Phase, Species
86     
87           CHARACTER(len=32) SA1, SA2
88     
89           CALL INIT_ERR_MSG("RXN_COM --> checkDuplicateAliases")
90     
91     ! Set variables for error messages.
92           M1 = 0
93           M2 = 0
94     ! Compare gas phase aliases.
95           DO N1 = 1, lNg
96              SA1 =SA_g(N1)
97              IF(len_trim(SA1) == 0) CYCLE
98              DO N2=N1+1,lNg
99                 SA2 = SA_g(N2)
100                 IF(len_trim(SA2) == 0) CYCLE
101                 IF(compareAliases(SA1, SA2)) GoTo 100
102              ENDDO
103     ! Compare gas and solids phase aliases.
104              DO M2 = 1, lMMx
105                 DO N2 = 1, lNs(M2)
106                    SA2 = SA_s(M2,N2)
107                    IF(len_trim(SA2) == 0) CYCLE
108                    IF(compareAliases(SA1, SA2)) GoTo 100
109                 ENDDO
110              ENDDO
111           ENDDO
112     ! Compare aliases between solids phases
113           DO M1 = 1, lMMx
114              DO N1 = 1, lNs(M1)
115                 SA1 = SA_s(M1,N1)
116                 IF(len_trim(SA1) == 0) CYCLE
117     ! Self phase comparison.
118                 M2 = M1
119                 DO N2=N1+1, lNs(M2)
120                    SA2 = SA_s(M2,N2)
121                    IF(len_trim(SA2) == 0) CYCLE
122                    IF(compareAliases(SA1, SA2)) GoTo 100
123                 ENDDO
124     ! Compare with other phases.
125                 DO M2 = M1+1, lMMx
126                    DO N2 = 1, lNs(M2)
127                       SA2 = SA_s(M2,N2)
128                       IF(len_trim(SA2) == 0) CYCLE
129                       IF(compareAliases(SA1, SA2)) GoTo 100
130                    ENDDO
131                 ENDDO
132              ENDDO
133           ENDDO
134     
135           CALL FINL_ERR_MSG
136           RETURN
137     
138       100 WRITE(ERR_MSG, 1100) M1, N1, SA1, M2, N2, SA2
139           CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
140     
141      1100 FORMAT('Error 1100: Non-unique species aliases detected.',/      &
142              3x,'Phase: ',I2,', Species: ',I3,' - Alias: ',A,/             &
143              3x,'Phase: ',I2,', Species: ',I3,' - Alias: ',A,//            &
144              'Please correct the mfix.dat file.')
145     
146           END SUBROUTINE checkDuplicateAliases
147     
148     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
149     !  Function name: checkSpeciesInc()                                    !
150     !                                                                      !
151     !  Purpose: Loop through the species.inc file and verify that the      !
152     !  match those provided in the datafile.                               !
153     !                                                                      !
154     !  Variables referenced: None                                          !
155     !                                                                      !
156     !  Variables modified: None                                            !
157     !                                                                      !
158     !  Local variables: None                                               !
159     !                                                                      !
160     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
161           SUBROUTINE checkSpeciesInc(lNg, SA_g, lMMx, lNs, SA_s,           &
162              lNRxn,  lRNames, lNRxn_DES, lRNames_DES)
163     
164           use run, only: REINITIALIZING
165           use error_manager
166           use toleranc
167           USE utilities, ONLY: blank_line, seek_comment
168     
169           IMPLICIT NONE
170     
171     ! Number of gas speices
172           INTEGER, INTENT(IN) :: lNg
173     ! Gas phase species aliases
174           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: SA_g
175     ! Number of solids phases
176           INTEGER, INTENT(IN) :: lMMx
177     ! Number of species in each solids phase.
178           INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
179     ! Solids phase speices aliases.
180           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: SA_s
181     ! Number of reactions
182           INTEGER, INTENT(IN) :: lNRxn
183     ! Reaction Names (aliases)
184           CHARACTER(len=32), INTENT(IN) ::  lRNames(DIMENSION_RXN)
185     ! Number of discrete reactions
186           INTEGER, INTENT(IN) :: lNRxn_DES
187     ! Reaction Names for discrete solids (aliases)
188           CHARACTER(len=32), INTENT(IN) ::  lRNames_DES(DIMENSION_RXN)
189     
190     ! Input/Output status.
191           INTEGER :: IOS
192     ! File unit.
193           INTEGER, PARAMETER :: FUNIT = 167
194     ! Full path to Burcat and Ruscic database
195           CHARACTER(len=255) :: FILENAME
196           CHARACTER(len=128) :: INPUT
197     ! Loop counters
198           INTEGER :: SRC, M
199     ! Position of interest in string.
200           INTEGER :: POS
201     ! Index from species.inc file.
202           INTEGER :: lIndex
203           CHARACTER(len=64) :: lName
204           CHARACTER(len=32) :: tName
205     ! Length of noncomment string
206           INTEGER :: LINE_LEN
207     
208           CALL INIT_ERR_MSG("RXN_COM --> checkDuplicateAliases")
209     
210           SRC = 0
211     
212     ! Loop over possible locations .
213           SRC_LP: DO
214              SRC = SRC + 1
215              SELECT CASE(SRC)
216     
217     ! Check the local run directory.
218              CASE(1); FILENAME = 'species.inc'
219                 OPEN(CONVERT='BIG_ENDIAN',UNIT=FUNIT,FILE=trim(FILENAME),STATUS='OLD',IOSTAT=IOS)
220                 IF(IOS /= 0) CYCLE SRC_LP
221                 IF(.NOT.REINITIALIZING)THEN
222                    WRITE(ERR_MSG, 1000)'species.inc'
223                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
224                 ENDIF
225     
226      1000 FORMAT(/2X,'Verifying reaction aliases in ',A)
227     
228     ! No species.inc file was located.
229              CASE DEFAULT
230                 IF(.NOT.REINITIALIZING)THEN
231                    WRITE(ERR_MSG, 1004)
232                    CALL FLUSH_ERR_MSG
233                 ENDIF
234                 EXIT SRC_LP
235              END SELECT
236     
237      1004 FORMAT('Warning 1004: Unable to locate the species.inc file. No ',&
238              'verification',/'of mfix.dat species aliases or reaction ',    &
239              'names can be preformed.')
240     
241              REWIND(FUNIT)
242              READ_LP: DO
243                 READ(FUNIT,"(A)",IOSTAT=IOS) INPUT
244     
245     ! This is a sanity check because the species.inc file is generated by
246     ! make_mfix and therefore should be the correct format.
247                 IF(IOS > 0) THEN
248                    WRITE(ERR_MSG,1200) trim(adjustl(FILENAME))
249                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
250      1200 FORMAT('Error 1200: There was a problem reading file: ',A)
251     
252     ! All entries have been processed.
253                 ELSEIF(IOS<0)THEN
254                    EXIT SRC_LP
255                 ENDIF
256     
257     ! Clean up the input.
258                 LINE_LEN = SEEK_COMMENT(INPUT,LEN(INPUT)) - 1
259                 CALL REMOVE_COMMENT(INPUT, LINE_LEN + 1, LEN(INPUT))
260                 CALL MAKE_UPPER_CASE(INPUT, LINE_LEN)
261                 CALL REPLACE_TAB(INPUT, LINE_LEN)
262     
263     ! Skip empty entires.
264                 IF(LINE_LEN <= 0) CYCLE READ_LP
265                 IF(BLANK_LINE(INPUT)) CYCLE READ_LP
266     
267                 POS = INDEX(INPUT,"INTEGER, PARAMETER ::")
268                 IF(POS /= 0) THEN
269                    INPUT = INPUT((POS + 21):)
270                 ELSE
271                    CYCLE READ_LP
272                 ENDIF
273     
274     ! We only want to process lines that have = as the other are coments.
275                 POS = INDEX(INPUT,"=")
276                 IF(POS == 0) CYCLE READ_LP
277     
278     ! Store the species alias.
279                 WRITE(lName,"(A)") trim(adjustl(INPUT(:(POS-1))))
280     
281     ! Convert the read index from string to integer. Report any errors.
282                 READ(INPUT((POS+1):),*,IOSTAT=IOS) lIndex
283                 IF(IOS /= 0) THEN
284                    WRITE(ERR_MSG,1205) 'index', trim(INPUT)
285                    CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
286                 ENDIF
287     
288      1205 FORMAT('Error 1205: Unable to obtain alias index from species.', &
289              'inc file.',//' INPUT: ',A)
290     
291     ! Match against what was provided in the datafile:
292     ! Gas phase species aliases.
293                 IF(lIndex <= lNg) THEN
294                    tName = SA_g(lIndex)
295                    IF(compareAliases(tName, lName)) CYCLE READ_LP
296                 ENDIF
297     
298     ! Solids phase species aliases.
299                 DO M = 1, lMMx
300                    IF(lIndex <= lNs(M))THEN
301                       tName = SA_s(M, lIndex)
302                       IF(compareAliases(tName, lName)) CYCLE READ_LP
303                    ENDIF
304                 ENDDO
305     
306     ! Reaction Names
307                 IF(lIndex <= lNRxn)THEN
308                    tName =  lRNames(lIndex)
309                    IF(compareAliases(tName, lName)) CYCLE READ_LP
310                 ENDIF
311     
312     ! Reaction Names for discrete solids
313                 IF(lIndex <= lNRxn_DES)THEN
314                    tName =  lRNames_DES(lIndex)
315                    IF(compareAliases(tName, lName)) CYCLE READ_LP
316                 ENDIF
317     
318                 WRITE(ERR_MSG,1300) trim(lName), lIndex
319                 CALL FLUSH_ERR_MSG
320     
321      1300 FORMAT('Error 1300: An entry in the species.inc file does not ', &
322              'match any inputs',/'in the mfix.dat file.'/3x,'Name: ',A,4x, &
323              'Index: ',I3,/'If the quantity or order of gas species, ',    &
324              'solids species, or chemical',/'reactions has changed, then ',&
325              'the executable must be re-build. Please',/'see the document',&
326              'ation for specifying chemical reactions.')
327     
328              ENDDO READ_LP
329           ENDDO SRC_LP
330     
331           CLOSE(FUNIT)
332           CALL FINL_ERR_MSG
333           RETURN
334     
335           END SUBROUTINE checkSpeciesInc
336     
337     
338     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
339     !  Function name: compareAlaises()                                     !
340     !                                                                      !
341     !  Purpose:                                                            !
342     !                                                                      !
343     !  Variables referenced: None                                          !
344     !                                                                      !
345     !  Variables modified: None                                            !
346     !                                                                      !
347     !  Local variables: None                                               !
348     !                                                                      !
349     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
350           LOGICAL FUNCTION compareAliases(lS1, lS2, N1, N2)
351     
352           IMPLICIT NONE
353     
354           CHARACTER(len=*), INTENT(IN) :: lS1, lS2
355     
356           INTEGER, OPTIONAL, INTENT(IN) :: N1, N2
357     
358           CALL MAKE_UPPER_CASE (lS1, len(lS1))
359           CALL MAKE_UPPER_CASE (lS2, len(lS2))
360     
361           compareAliases = .FALSE.
362           IF(trim(lS1) == trim(lS2)) compareAliases = .TRUE.
363     
364           IF(.NOT.compareAliases) RETURN
365     
366           IF(PRESENT(N1) .AND. PRESENT(N2)) THEN
367              IF(N1 == N2) THEN
368                 compareAliases = .TRUE.
369              ELSE
370                 compareAliases = .FALSE.
371              ENDIF
372           ENDIF
373     
374           RETURN
375           END FUNCTION compareAliases
376     
377     
378     
379     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
380     !  Subroutine: WRITE_RXN_SUMMARY                                       !
381     !                                                                      !
382     !  Purpose:                                                            !
383     !                                                                      !
384     !  Variables referenced: None                                          !
385     !                                                                      !
386     !  Variables modified: None                                            !
387     !                                                                      !
388     !  Local variables: None                                               !
389     !                                                                      !
390     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
391           SUBROUTINE WRITE_RXN_SUMMARY(RxN, lSAg, lSAs, ABORT, fUNIT)
392     
393           USE toleranc
394     
395           IMPLICIT NONE
396     
397     ! Data structure for storing reaction data.
398           TYPE(REACTION_BLOCK), POINTER, INTENT(IN) :: RxN
399     
400     ! Gas phase species aliases
401           CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
402     ! Solids phase speices aliases.
403           CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
404     ! Flag to abort the run.
405           LOGICAL, INTENT(IN) :: ABORT
406     
407     ! Optional file unit.
408           INTEGER, OPTIONAL :: fUNIT
409     
410           CHARACTER(LEN=72) :: OUTPUT, full, divided, empty
411     
412           CHARACTER(LEN=32) :: lSP
413     
414           INTEGER lN, M, N
415           INTEGER lS, lE
416     
417           INTEGER UNIT_FLAG
418     
419           IF(present(fUnit)) THEN
420              UNIT_FLAG = fUNIT
421           ELSE
422              UNIT_FLAG = -1
423           ENDIF
424     
425           empty = '  '
426           CALL WRITE_RS0(empty, UNIT_FLAG)
427     
428           full = ''
429           WRITE(full,2000)
430     
431           divided = ''
432           WRITE(divided,2005)
433     
434     ! Lead bar
435           CALL WRITE_RS0(full, UNIT_FLAG)
436     ! Reaction Nmae
437           OUTPUT = ''
438           WRITE(OUTPUT, 2001)trim(RxN%Name)
439           OUTPUT(72:72) = '|'
440           CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
441     
442     ! Row Divider
443           CALL WRITE_RS0(full, UNIT_FLAG)
444     
445           OUTPUT = ''
446           WRITE(OUTPUT, 2002)trim(RxN%ChemEq(1:54))
447           OUTPUT(72:72) = '|'
448           CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
449     
450           CALL WRITE_RS0(full, UNIT_FLAG)
451     
452           IF(RxN%nSpecies > 0) THEN
453     
454              OUTPUT = ''
455              WRITE(OUTPUT, 2007)trim(RxN%Classification)
456              OUTPUT(72:72) = '|'
457              CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
458     ! Row Divider
459              CALL WRITE_RS0(full, UNIT_FLAG)
460     
461              WRITE(OUTPUT,2003); CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
462              WRITE(OUTPUT,2004); CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
463              CALL WRITE_RS0(divided, UNIT_FLAG)
464           ENDIF
465     
466     
467           DO lN = 1, RxN%nSpecies
468     
469              M = RxN%Species(lN)%pMap
470              N = RxN%Species(lN)%sMap
471     
472              WRITE(OUTPUT,2006)
473     
474              IF(M == 0) THEN
475                 IF(len_trim(lSAg(N)) > 8) THEN
476                    lSP = lSAg(N)
477                    OUTPUT(5:13) = lSP(1:8)
478                 ELSE
479                   lS = (9-int(len_trim(lSAg(N))/2))
480                   lE = lS + len_trim(lSAg(N))
481                    OUTPUT(lS:lE) = trim(lSAg(N))
482                 ENDIF
483                 WRITE(OUTPUT(32:35),"(A)") 'Gas'
484              ELSE
485                 IF(len_trim(lSAs(M,N)) > 8) THEN
486                    lSP = lSAs(M,N)
487                    OUTPUT(5:13) = lSP(1:8)
488                 ELSE
489                    lS = (9-int(len_trim(lSAs(M,N))/2))
490                    lE = lS + len_trim(lSAs(M,N))
491                    OUTPUT(lS:lE) = trim(lSAs(M,N))
492                 ENDIF
493                 WRITE(OUTPUT(30:36),"(A,I2)") 'Solid',M
494              ENDIF
495              WRITE(OUTPUT(43:44),"(I2)") N
496              WRITE(OUTPUT(51:60),"(F9.4)") RxN%Species(lN)%MW
497     
498              IF(COMPARE(RxN%Species(lN)%Coeff, ZERO)) THEN
499                 WRITE(OUTPUT(17:26),"(F9.4)") ZERO
500                 WRITE(OUTPUT(63:71),"(A)") 'Catalyst'
501              ELSEIF(RxN%Species(lN)%Coeff < ZERO) THEN
502                 WRITE(OUTPUT(17:26),"(F9.4)") -RxN%Species(lN)%Coeff
503                 WRITE(OUTPUT(63:71),"(A)") 'Reactant'
504              ELSE
505                 WRITE(OUTPUT(17:26),"(F9.4)")  RxN%Species(lN)%Coeff
506                 WRITE(OUTPUT(63:70),"(A)") 'Product'
507              ENDIF
508              CALL WRITE_RS0(OUTPUT, UNIT_FLAG)
509              CALL WRITE_RS0(divided, UNIT_FLAG)
510     
511           ENDDO
512     
513           CALL WRITE_RS0(empty, UNIT_FLAG)
514     
515           IF(ABORT) CALL MFIX_EXIT(myPE)
516           RETURN
517     
518     
519      2000 FORMAT(2X,'|',68('-'),'|')
520     
521      2001 FORMAT(2X,'| Name: ',A)
522      2002 FORMAT(2x,'| Chemical Eq: ',A)
523     
524      2003 FORMAT('  | Species  |   Stoich    |         | Species |',       &
525                   ' Molecular  |          |')
526     
527      2004 FORMAT('  |  Alias   |   Coeff.    |  Phase  |  Index  |',       &
528                   '   Weight   |   Type   |')
529     
530     
531      2005 FORMAT(2X,'|',10('-'),'|',13('-'),'|',9('-'),'|',9('-'),'|',     &
532                  12('-'),'|',10('-'),'|')
533     
534      2006 FORMAT(2X,'|',10(' '),'|',13(' '),'|',9(' '),'|',9(' '),'|',     &
535                  12(' '),'|',10(' '),'|')
536     
537     
538      2007 FORMAT(2X,'| Classification: ',A)
539     
540           contains
541     
542     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
543     !  Subroutine: WRITE_RS0                                               !
544     !                                                                      !
545     !  Purpose:                                                            !
546     !                                                                      !
547     !  Variables referenced: None                                          !
548     !                                                                      !
549     !  Variables modified: None                                            !
550     !                                                                      !
551     !  Local variables: None                                               !
552     !                                                                      !
553     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
554           SUBROUTINE WRITE_RS0(LINE, UFLAG)
555     
556           use run, only: REINITIALIZING
557           use error_manager
558     
559           IMPLICIT NONE
560     
561           CHARACTER(len=*), INTENT(IN) :: LINE
562           INTEGER, INTENT(IN) :: UFLAG
563     
564           CALL INIT_ERR_MSG("WRITE_RXN_SUMMARY --> WRITE_RS0")
565     
566           IF(UFLAG == -1)THEN
567              IF(.NOT.REINITIALIZING) THEN
568                 WRITE(ERR_MSG,*) LINE
569                 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
570              ENDIF
571           ELSE
572              WRITE(UFLAG,*) LINE
573           ENDIF
574           CALL FINL_ERR_MSG
575     
576           RETURN
577           END SUBROUTINE WRITE_RS0
578           END SUBROUTINE WRITE_RXN_SUMMARY
579     
580     
581     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
582     !  Subroutine: checkThermoReqs                                         !
583     !                                                                      !
584     !  Purpose:                                                            !
585     !                                                                      !
586     !  Variables referenced: None                                          !
587     !                                                                      !
588     !  Variables modified: None                                            !
589     !                                                                      !
590     !  Local variables: None                                               !
591     !                                                                      !
592     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
593           SUBROUTINE checkThermoReqs(RxN, S_g, S_s, rDB, MWg, MWs, Cpg0, Cps0)
594     
595           use error_manager
596           use toleranc
597     
598           IMPLICIT NONE
599     
600     ! Data structure for storing reaction data.
601           TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
602     
603           CHARACTER(len=18), INTENT(IN) :: S_g(DIM_N_g)
604           CHARACTER(len=18), INTENT(in) :: S_s(DIM_M, DIM_N_s)
605           LOGICAL, INTENT(inout) :: rDB(0:DIM_M, DIM_N_g)
606           DOUBLE PRECISION, INTENT(in) :: Cpg0
607           DOUBLE PRECISION, INTENT(in) :: Cps0(DIM_M)
608           DOUBLE PRECISION, INTENT(inout) :: MWg(DIM_N_g)
609           DOUBLE PRECISION, INTENT(inout) :: MWs(DIM_M, DIM_N_s)
610     
611           LOGICAL :: CP_FATAL
612           LOGICAL :: CHECK_DATABASE
613     
614           INTEGER :: M, N, lN
615     
616     
617           CALL INIT_ERR_MSG("RXN_COM --> checkThermoReqs")
618     
619           CHECK_DATABASE = .FALSE.
620           CP_FATAL = .FALSE.
621     
622     ! Verify that the molecular weights and stoichiometry are consistent and
623     ! determine interphase mass exchanges.
624           DO lN = 1, RxN%nSpecies
625              M = RxN%Species(lN)%pMap
626              N = RxN%Species(lN)%sMap
627              IF(M == 0) THEN
628                 IF(Cpg0 /= UNDEFINED) THEN
629                    CP_FATAL = .TRUE.
630                 ELSEIF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
631                    (MWg(N) == UNDEFINED)) THEN
632                    CHECK_DATABASE = .TRUE.
633                 ENDIF
634              ELSE
635                 IF(Cps0(M) /= UNDEFINED) THEN
636                    CP_FATAL = .TRUE.
637                 ELSEIF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
638                    (MWs(M,N) == UNDEFINED)) THEN
639                    CHECK_DATABASE = .TRUE.
640                 ENDIF
641              ENDIF
642           ENDDO
643     
644     ! Report errors and messages.
645           IF(CP_FATAL) THEN
646     
647              WRITE(ERR_MSG, 1100) trim(RxN%Name)
648              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
649     
650      1100 FORMAT('Error 1100: One or more phases associated with ',        &
651              'reaction ',A,/'has specified constant specific heat (C_PG0/',&
652              'Cps0). This is',/'not permitted for reacting phases. ',     &
653              'Please correct the mfix.dat file.')
654     
655           ELSEIF(CHECK_DATABASE) THEN
656     
657              WRITE(ERR_MSG, 1101) trim(RxN%Name)
658              CALL FLUSH_ERR_MSG
659     
660      1101 FORMAT('Message 1101: One or more molecular weights and/or ',    &
661              'thermochemical data',/'is needed for reaction ',A,'. The ',  &
662              'thermochemical database',/'will be used to gather the ',     &
663              'necessary data.')
664     
665           ENDIF
666     
667           IF(CHECK_DATABASE) THEN
668              WRITE(ERR_MSG, 1200)
669              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
670           ENDIF
671     
672      1200 FORMAT('Message 1200: Searching thermochemical databases for ',&
673              'species data.',/'  ')
674     
675           DO lN = 1, RxN%nSpecies
676              M = RxN%Species(lN)%pMap
677              N = RxN%Species(lN)%sMap
678              IF(M == 0) THEN
679                 IF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.         &
680                    (MWg(N) == UNDEFINED)) THEN
681     ! Notify the user of the reason the thermochemical database is used.
682     ! Flag that the species name is not provided.
683                    IF(S_g(N) == UNDEFINED_C) THEN
684                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_g',N))
685                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
686                    ENDIF
687     
688     ! Update the log files.
689                    WRITE(ERR_MSG, 3001) N, trim(S_g(N))
690                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
691     ! Read the database.
692                    CALL READ_DATABASE(0, N, S_g(N), MWg(N))
693     ! Flag variable to stating that the database was read.
694                    rDB(0,N) = .TRUE.
695                 ENDIF
696                 RxN%Species(lN)%MW = MWg(N)
697              ELSE
698                 IF((RxN%Calc_DH .AND. .NOT.rDB(M,N)) .OR.        &
699                    (MWs(M,N) == UNDEFINED)) THEN
700     
701     ! Flag that the species name is not provided.
702                    IF(S_s(M,N) == UNDEFINED_C) THEN
703                       WRITE(ERR_MSG,1000) trim(iVar('SPECIES_s',M,N))
704                       CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
705                    ENDIF
706     ! Update the log files.
707                    WRITE(ERR_MSG, 3001) N, trim(S_s(M,N))
708                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
709                    CALL READ_DATABASE(M,N,S_s(M,N),MWs(M,N))
710     ! Flag variable to stating that the database was read.
711                    rDB(M,N) = .TRUE.
712                 ENDIF
713                 RxN%Species(lN)%MW = MWs(M,N)
714              ENDIF
715           ENDDO
716     ! Finalize the error message.
717           IF(CHECK_DATABASE) CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
718     
719      3001 FORMAT(/2x,'>',I3,': Species: ',A)
720     
721           CALL FINL_ERR_MSG
722     
723           RETURN
724     
725      1000 FORMAT('Error 1000: Required input not specified: ',A,/'Please ',&
726                 'correct the mfix.dat file.')
727     
728           END SUBROUTINE checkThermoReqs
729     
730     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
731     !  Subroutine: checkMassBalance                                        !
732     !                                                                      !
733     !  Purpose:                                                            !
734     !                                                                      !
735     !  Variables referenced: None                                          !
736     !                                                                      !
737     !  Variables modified: None                                            !
738     !                                                                      !
739     !  Local variables: None                                               !
740     !                                                                      !
741     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
742           SUBROUTINE checkMassBalance(CALLER, RxN, lnMT, IER)
743     
744           USE toleranc
745     
746           IMPLICIT NONE
747     
748           CHARACTER(len=*), INTENT(IN) :: CALLER
749     
750     ! Data structure for storing reaction data.
751           TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
752     
753           DOUBLE PRECISION, INTENT(OUT) :: lnMT(0:DIM_M)
754           INTEGER, INTENT(OUT) :: IER
755     
756           INTEGER M, N, lN ! Phase, Species
757           DOUBLE PRECISION rSUM, pSUM
758           DOUBLE PRECISION MWxStoich
759     
760           INTEGER sprCount, sprIndex
761     
762           DOUBLE PRECISION, PARAMETER :: massBalanceTol = 1.0d-3
763     
764     ! Initialize variables
765           IER = 0
766           rSUM = ZERO
767           pSUM = ZERO
768           lnMT(:) = ZERO
769           sprCount = 0
770     
771     ! Verify that the molecular weights and stoichiometry are consistent and
772     ! determine interphase mass exchanges.
773           DO lN = 1, RxN%nSpecies
774              M = RxN%Species(lN)%pMap
775              N = RxN%Species(lN)%sMap
776     
777     ! Multiply the molecular weight and stoichiometric coefficient.
778              MWxStoich = RxN%Species(lN)%MW * RxN%Species(lN)%Coeff
779              RxN%Species(lN)%MWxStoich = MWxStoich
780     ! Calculate the net mass transfer for phase M.
781     !  0 : no interphase mass transfder
782     ! >0 : gains mass from anther phase
783     ! <0 : transfers mass to anther phase
784              lnMT(M) = lnMT(M) + MWxStoich
785     ! Calculate mass of reactants and products. Used to ensure mass balance.
786              IF(MWxStoich < ZERO) THEN
787                 rSUM = rSUM - MWxStoich
788                 IF(M /= 0) THEN
789                    sprCount = sprCount + 1
790                    IF(sprCount == 1) THEN
791                       sprIndex = M
792     ! Verify that there is at most one solids phase fule (reactant).
793                    ELSEIF( M /= sprIndex) THEN
794                       IF(DMP_LOG) THEN
795                          WRITE(*,1002) trim(CALLER), trim(RxN%Name)
796                          WRITE(UNIT_LOG,1002) trim(CALLER), trim(RxN%Name)
797                          IER = 1
798                       ENDIF
799                    ENDIF
800                 ENDIF
801              ELSE
802                 pSUM = pSUM + MWxStoich
803              ENDIF
804           ENDDO
805     ! Verify that the mass of products equals reactants: (Mass Balance)
806           IF (.NOT.COMPARE(rSUM,pSUM)) THEN
807              IF(DMP_LOG) THEN
808                 WRITE(*,1001) trim(CALLER), trim(RxN%Name), rSUM, pSUM
809                 WRITE(UNIT_LOG,1001) trim(CALLER), trim(RxN%Name), rSUM,pSUM
810                 IER = 1
811              ENDIF
812           ENDIF
813     
814           RETURN
815     
816     ! Error Messages
817     !---------------------------------------------------------------------//
818     
819      1001 FORMAT(/1X,70('*')/' From: ',A,' --> RXN_COM -->',               &
820              ' checkMassBalance',/' Error 1001: Stoichiometry is not',     &
821              ' consistent with molecular weights',/' for reaction ',A,'.',/&
822              ' Mass of reactants: ',F12.4,/' Mass of products:  ',F12.4,/  &
823              1X,70('*')/)
824     
825      1002 FORMAT(/1X,70('*')/' From: ',A,' --> RXN_COM -->',               &
826              ' checkMassBalance',/' Error 1002: More than one solids',     &
827              ' phase fules was detected. Unable to',/' determine solids/', &
828              'solids heat of reaction unambiguously for',/' reaction ',A,  &
829              '.',/1X,70('*')/)
830     
831           END SUBROUTINE checkMassBalance
832     
833     
834     
835     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
836     !  Subroutine: calcInterphaseTxfr                                      !
837     !                                                                      !
838     !  Purpose:                                                            !
839     !                                                                      !
840     !  Variables referenced: None                                          !
841     !                                                                      !
842     !  Variables modified: None                                            !
843     !                                                                      !
844     !  Local variables: None                                               !
845     !                                                                      !
846     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
847           SUBROUTINE calcInterphaseTxfr(CALLER, RxN, lnMT, lEEq, lSEq, &
848              lSAg, lMMx, lSAs)
849     
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