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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: PARSE_RXN(LINE, LMAX)                                  C
4     !  Purpose: Parse input line                                           C
5     !                                                                      C
6     !  Author: P. Nicoletti                               Date: 30-JUN-97  C
7     !                                                                      C
8     !  Revision Number: 1                                                  C
9     !  Purpose: This routine was complete rewritten as part of the effort  C
10     !  to simplify reaction inputs in MFiX.
11     !  Author: J. Musser                                  Date: 01-Oct-12  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced:                                               C
17     !  Variables modified:                                                 C
18     !                                                                      C
19     !  Local variables:                                                    C
20     !                                                                      C
21     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
22           SUBROUTINE PARSE_RXN(LINE, lNoOfRxns, lName, lChemEq, lDH, lFDH)
23     
24     !-----------------------------------------------
25     !   M o d u l e s
26     !-----------------------------------------------
27           USE compar
28           USE funits
29           USE param
30           USE param1
31           USE parse
32     
33           IMPLICIT NONE
34     
35     ! Input line from mfix.dat.
36           CHARACTER(len=*), INTENT(IN) :: LINE
37     ! Array of reaction names.
38           INTEGER, INTENT(INOUT) :: lNoOfRxns
39     ! Array of reaction names.
40           CHARACTER(len=*), INTENT(INOUT), DIMENSION(DIMENSION_RXN) :: lName
41     ! Array of Chemical reaction equations.
42           CHARACTER(len=*), INTENT(INOUT), DIMENSION(DIMENSION_RXN) :: lChemEq
43     ! Array of User defined heat of reactions.
44           DOUBLE PRECISION, INTENT(INOUT), DIMENSION(DIMENSION_RXN) :: lDH
45     ! Array of User defined heat of reaction phase partitions.
46           DOUBLE PRECISION, INTENT(INOUT), DIMENSION(DIMENSION_RXN, 0:DIM_M) :: lFDH
47     
48     
49     !-----------------------------------------------
50     !   L o c a l   P a r a m e t e r s
51     !-----------------------------------------------
52     !-----------------------------------------------
53     !   L o c a l   V a r i a b l e s
54     !-----------------------------------------------
55     
56           CHARACTER, PARAMETER :: CT_BEG = '{'
57           CHARACTER, PARAMETER :: CT_END = '}'
58     
59     ! Positions of braces {...}
60           INTEGER bIDX, eIDX
61     ! Reaction Name
62           CHARACTER(LEN=128) :: INPUT
63     ! Index of reaction.
64           INTEGER IDX
65     
66     ! Copy line to input for processing.
67           INPUT = TRIM(ADJUSTL(LINE))
68     
69     ! Look for the start and end of a reaction construct by checking for
70     ! left and right braces.
71           bIDX = INDEX(INPUT,CT_BEG)
72           eIDX = INDEX(INPUT,CT_END)
73     
74     ! If not already inside/reading from a reaction construct, check to see
75     ! if this is the start of a construct.
76           IF(.NOT.IN_CONSTRUCT) THEN
77     
78     ! An identifier for the end of a construct was found.
79              IF(eIDX .GT. 0) THEN
80                 IF(eIDX .GT. bIDX) THEN
81     ! The reaction construct is specified in a single line.
82     ! rxn_name { A + B --> AB }
83                    IDX = getReactionIndex(lNoOfRxns, 'NEW')
84     ! Pull off the reaction construct name.
85                    CALL getName(INPUT,(bIDX-1), lNAME(IDX))
86     ! Process the rest of the line.
87                    IF(isFracDH(INPUT(bIDX+1:eIDX-1)))THEN
88                       WRITE(*, 1002) 'FracDH', trim(adjustl(INPUT))
89                       WRITE(*, 1000)
90                       CALL MFIX_EXIT(myPE)
91                    ELSEIF(isDH(INPUT(bIDX+1:eIDX-1)))THEN
92                       WRITE (*, 1002) 'DH', trim(adjustl(INPUT))
93                       WRITE(*, 1000)
94                       CALL MFIX_EXIT(myPE)
95                    ELSEIF(.NOT.isChemEq(INPUT(bIDX+1:eIDX-1)))THEN
96                       WRITE (*, 1003) trim(adjustl(INPUT))
97                       WRITE(*, 1000)
98                       CALL MFIX_EXIT(myPE)
99                    ENDIF
100                    CALL getChemEq(INPUT(bIDX+1:eIDX-1), lChemEq(IDX))
101                 ELSE
102     ! The format given in the deck file is incorrect. Brace mismatch.
103                    WRITE(*, 1001) trim(adjustl(LINE))
104                    WRITE(*, 1000)
105                    CALL MFIX_EXIT(myPE)
106                 ENDIF
107              ELSE
108     ! This is the start of a reaction construct.
109                 IF(bIDX .GT. 0) THEN
110     ! Get the reaction index.
111                    IDX = getReactionIndex(lNoOfRxns, 'NEW')
112     ! Extract the reaction name.
113                    CALL getName(INPUT,(bIDX-1), lNAME(IDX))
114     ! Process any data.
115                    IF(LEN_TRIM(ADJUSTL(INPUT(bIDX+1:eIDX-1))) .GT. 0)      &
116                      CALL readConstruct(INPUT(bIDX+1:eIDX-1),              &
117                         lChemEq(IDX), lDH(IDX), lFDH(IDX,:))
118                    IN_CONSTRUCT = .TRUE.
119                 ELSE
120     ! Format Error.
121                    WRITE(*, 1004) trim(adjustl(INPUT))
122                    WRITE(*, 1000)
123                    CALL MFIX_EXIT(myPE)
124                 ENDIF
125              ENDIF
126           ELSE
127     
128              IF(bIDX .GT. 0) THEN
129     ! Format Error.
130                 WRITE(*, 1005) trim(adjustl(INPUT))
131                 WRITE(*, 1000)
132                 CALL MFIX_EXIT(myPE)
133     ! This is the last line of the reaction construct which may or may not
134     ! contain additional data.
135              ELSEIF(eIDX .GT. 0) THEN
136                IDX = getReactionIndex(lNoOfRxns)
137                CALL readConstruct(INPUT(bIDX+1:eIDX-1), lChemEq(IDX),      &
138                   lDH(IDX), lFDH(IDX,:))
139                 IN_CONSTRUCT = .FALSE.
140     
141     ! Reading from somewhere inside of a reaction construct.
142              ELSE
143                IDX = getReactionIndex(lNoOfRxns)
144                CALL readConstruct(INPUT(bIDX+1:), lChemEq(IDX),            &
145                   lDH(IDX), lFDH(IDX,:))
146              ENDIF
147           ENDIF
148     
149           RETURN
150     
151      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
152              ' Error 1001: Mismatch of braces "{...}" in reaction ',       &
153              ' construct.',//' INPUT: ',A)
154     
155      1002 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
156              ' Error 1002: Input format error in reaction construct.',     &
157              ' Opening and',/' closing braces were found on the same line',&
158              ' along with the',/' keyword ',A,'.',/' Single line',         &
159              ' constructs can only contain a chemcial equation.',//        &
160              ' INPUT: ',A,//                                               &
161              ' Example 1: RXN_NAME { chem_eq = "A + B --> AB" }',//        &
162              ' Example 2: RXN_NAME {',/14X,'chem_eq = "A + B --> AB"',/14X,&
163              'DH = 2.5d4',/14X,'fracDH(0) = 1.0',/12X,'}')
164     
165      1003 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
166              ' Error 1003: Input format error in reaction construct.',     &
167              ' Opening and',/' closing braces were found on the same line',&
168              ' and chem_eq was NOT found.',/' Single line constructs can', &
169              ' only contain a chemcial equation.',//' INPUT: ',A,//        &
170              ' Example 1: RXN_NAME { chem_eq = "A + B --> AB" }',//        &
171              ' Example 2: RXN_NAME {',/14X,'chem_eq = "A + B --> AB"',/14X,&
172              'DH = 2.5d4',/14X,'fracDH(0) = 1.0',/12X,'}')
173     
174      1004 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
175              ' Error 1004: Data within the reaction block was identified', &
176              ' outside of a',/' reaction construct. ',//' INPUT: ',A)
177     
178      1005 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
179              ' Error 1005: The start of a new reaction construct was',     &
180              ' found before the',/' closing of the previous construct.',// &
181              ' INPUT: ',A)
182     
183      1000 FORMAT(/' Please refer to the Readme file on the required input',&
184              ' format and make',/' the necessary corrections to the data', &
185              ' file.',/1X,70('*')//)
186     
187           CONTAINS
188     
189     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
190     !  Function name: getReactionIndex()                                   !
191     !                                                                      !
192     !  Purpose: Extract the reaction name from a construct.                !
193     !                                                                      !
194     !  Variables referenced: None                                          !
195     !                                                                      !
196     !  Variables modified: None                                            !
197     !                                                                      !
198     !  Local variables: None                                               !
199     !                                                                      !
200     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
201           INTEGER FUNCTION getReactionIndex(lNOR, STAT)
202     
203           use rxns
204     
205           IMPLICIT NONE
206     ! Number of reactions.
207           INTEGER, INTENT(INOUT) :: lNOR
208     ! Status
209           CHARACTER(len=*), INTENT(IN), OPTIONAL :: STAT
210     
211           IF(.NOT.PRESENT(STAT)) THEN
212              getReactionIndex = lNOR
213     
214           ELSE
215              IF(STAT == 'NEW') THEN
216     ! Increment the number of reactions processed from the data file and
217     ! return the new value as the index of the reactoin being processed.
218                 lNOR = lNOR + 1
219                 getReactionIndex = lNOR
220              ELSE
221                 WRITE(*,*) ' Unknown status'
222                 CALL MFIX_EXIT(myPE)
223              ENDIF
224           ENDIF
225     
226           RETURN
227           END FUNCTION getReactionIndex
228     
229     
230     
231     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
232     !  Function name: readConstruct(IN, ChemEq, uDH, uFDH)                 !
233     !                                                                      !
234     !  Purpose:                                                            !
235     !                                                                      !
236     !  Variables referenced: None                                          !
237     !                                                                      !
238     !  Variables modified: None                                            !
239     !                                                                      !
240     !  Local variables: None                                               !
241     !                                                                      !
242     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
243           SUBROUTINE readConstruct(IN, ChemEq, uDH, uFDH)
244     
245           IMPLICIT NONE
246     
247     ! Input string being parsed.
248           CHARACTER(len=*), INTENT(IN) :: IN
249     ! Chemical equation.
250           CHARACTER(len=*), INTENT(OUT) :: ChemEq
251     ! User defined heat of reaction.
252           DOUBLE PRECISION, INTENT(OUT) :: uDH
253     ! User defined splitting of heat of reaction
254           DOUBLE PRECISION, INTENT(OUT) :: uFDH(0:DIM_M)
255     
256     ! The input line contains no additional data.
257           IF(LEN_TRIM(ADJUSTL(IN)) == 0) RETURN
258     
259     ! The input contains chemical equation data.
260           IF(MORE_ChemEq .OR. isChemEq(IN)) THEN
261              CALL getChemEq(IN, ChemEq)
262     ! The input contains heat of reaction parsing data.
263           ELSEIF(isFracDH(IN)) THEN
264              CALL getFracDH(IN, uFDH(:))
265     ! The input contains heat of reaction data.
266           ELSEIF(isDH(IN)) THEN
267              CALL getDH(IN, uDH)
268     ! The entry doesn't match any of the keywords.
269           ELSE
270     ! Unidentified keyword.
271              WRITE(*, 1001) trim(adjustl(IN))
272              WRITE(*, 1000)
273              CALL MFIX_EXIT(myPE)
274           ENDIF
275     
276           RETURN
277     
278      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN --> readConstruct',/       &
279              ' Error 1001: Unidentified keyword in reaction construct.'//, &
280              ' INPUT: ',A)
281     
282      1000 FORMAT(/' Please refer to the Readme file on the required input',&
283              ' format and make',/' the necessary corrections to the data', &
284              ' file.',/1X,70('*')//)
285     
286           END SUBROUTINE readConstruct
287     
288     
289     
290     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
291     !  Function name: isChemEq(INPUT)                                      !
292     !                                                                      !
293     !  Purpose: Checks if the line contains the chemical Eq.               !
294     !                                                                      !
295     !  Variables referenced: None                                          !
296     !                                                                      !
297     !  Variables modified: None                                            !
298     !                                                                      !
299     !  Local variables: None                                               !
300     !                                                                      !
301     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
302           LOGICAL FUNCTION isChemEq(INPUT)
303     
304     ! Input line.
305           CHARACTER(len=*), INTENT(IN) :: INPUT
306     
307     ! Check to see if the line contains 'END'
308           IF (INDEX(LINE(1:),"CHEM_EQ") == 0) THEN
309     ! 'CHEM_EQ' was not found. This line does not contains a chemical eq.
310              isChemEq = .FALSE.
311           ELSE
312     ! 'CHEM_EQ' was found. This line contains all or part of a chemical eq.
313              isChemEq = .TRUE.
314           ENDIF
315     
316           END FUNCTION isChemEq
317     
318     
319     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
320     !  Function name: isDH(INPUT)                                          !
321     !                                                                      !
322     !  Purpose: Checks if the line contains user defined heat of reaction. !
323     !                                                                      !
324     !  Variables referenced: None                                          !
325     !                                                                      !
326     !  Variables modified: None                                            !
327     !                                                                      !
328     !  Local variables: None                                               !
329     !                                                                      !
330     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
331           LOGICAL FUNCTION isDH(INPUT)
332     
333     ! Input line.
334           CHARACTER(len=*), INTENT(IN) :: INPUT
335     
336     ! Check to see if the line contains 'END'
337           IF (INDEX(LINE(1:),"DH") == 0) THEN
338     ! 'DH' was not found. This line does not contains a heat of reaction.
339              isDH = .FALSE.
340           ELSE
341     ! 'DH' was found. This line contains the heat of reaction
342              isDH = .TRUE.
343           ENDIF
344     
345           END FUNCTION isDH
346     
347     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
348     !  Function name: isDH(INPUT)                                          !
349     !                                                                      !
350     !  Purpose: Checks if the line contains user defined heat of reaction. !
351     !                                                                      !
352     !  Variables referenced: None                                          !
353     !                                                                      !
354     !  Variables modified: None                                            !
355     !                                                                      !
356     !  Local variables: None                                               !
357     !                                                                      !
358     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
359           LOGICAL FUNCTION isFracDH(INPUT)
360     
361     ! Input line.
362           CHARACTER(len=*), INTENT(IN) :: INPUT
363     
364     ! Check to see if the line contains 'END'
365           IF (INDEX(LINE(1:),"FRACDH") == 0) THEN
366     ! 'FRACDH' was not found.
367              isFracDH = .FALSE.
368           ELSE
369     ! 'FRACDH' was found.
370              isFracDH = .TRUE.
371           ENDIF
372     
373           END FUNCTION isFracDH
374     
375     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
376     !  Subroutine name: get_ChemEq(INPUT, lNAME, IER)                      !
377     !                                                                      !
378     !  Purpose: Extract the reaction name from a construct.                !
379     !                                                                      !
380     !  Variables referenced: None                                          !
381     !                                                                      !
382     !  Variables modified: None                                            !
383     !                                                                      !
384     !  Local variables: None                                               !
385     !                                                                      !
386     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
387           SUBROUTINE getName(INPUT, rPOS, lNAME)
388     
389     ! Input line.
390           CHARACTER(len=*), INTENT(IN) :: INPUT
391     ! End of search location for reaction name.
392           INTEGER, INTENT(IN) :: rPOS
393     ! Name of reaction pulled from input.
394           CHARACTER(LEN=32) , INTENT(OUT) :: lNAME
395     
396           INTEGER NAME_LEN
397     
398     ! Initialize the return value.
399           lNAME = ''
400     ! Verify that the name is not too long. This should be caught by
401     ! preprocessing of the data file. However, if the user changed the
402     ! reaction name after compiling (an error check for later) this check
403     ! prevents and overflow error.
404           NAME_LEN = len_trim(adjustl(INPUT(1:rPOS)))
405           IF(NAME_LEN .GT. 32) THEN
406              WRITE(*, 1001) trim(adjustl(INPUT))
407              WRITE(*, 1000)
408              CALL MFIX_EXIT(myPE)
409     ! Verify that the name was not deleted after compiling.
410     ! prevents and overflow error.
411           ELSEIF(NAME_LEN .EQ. 0) THEN
412              WRITE(*, 1002) trim(adjustl(INPUT))
413              WRITE(*, 1000)
414              CALL MFIX_EXIT(myPE)
415           ELSE
416              lNAME = trim(adjustl(INPUT(1:rPOS)))
417           ENDIF
418     
419     ! There shouldn't be any crazy characters at this point because the
420     ! code should fail to compile if the reaction names are not defined
421     ! or contain invalid characters.
422     
423      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN --> get_ChemEq',/          &
424              ' Error 1001: Reaction name too long! Reaaction names are',   &
425              ' limited to 32',/' characters.',//' Reaction Name: ',A)
426     
427      1002 FORMAT(//1X,70('*')/' From: PARSE_RXN --> get_ChemEq',/          &
428              ' Error 1002: Unable to determine reaction name.',//          &
429              ' INPUT: ',A)
430     
431      1000 FORMAT(/' Please refer to the Readme file on the required input',&
432              ' format and make',/' the necessary corrections to the data', &
433              ' file.',/1X,70('*')//)
434     
435           RETURN
436           END SUBROUTINE getName
437     
438     
439     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
440     !  Subroutine name: getDH(INPUT, lDH)                                  !
441     !                                                                      !
442     !  Purpose: Extract the reaction name from a construct.                !
443     !                                                                      !
444     !  Variables referenced: None                                          !
445     !                                                                      !
446     !  Variables modified: None                                            !
447     !                                                                      !
448     !  Local variables: None                                               !
449     !                                                                      !
450     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
451           SUBROUTINE getDH(INPUT, lDH)
452     
453     ! Input line.
454           CHARACTER(len=*), INTENT(IN) :: INPUT
455     ! Name of reaction pulled from input.
456           DOUBLE PRECISION, INTENT(OUT) :: lDH
457     
458           INTEGER lQ
459           INTEGER lLMAX
460     ! read/write output status
461           INTEGER IOS
462     
463           lLMAX = LEN_TRIM(INPUT)
464     
465           IF(INDEX(INPUT,"DH") .EQ. 0) THEN
466              WRITE (*, 1100) trim(adjustl(INPUT))
467              WRITE(*, 1000)
468              CALL MFIX_EXIT(myPE)
469           ENDIF
470     
471           lQ = INDEX(INPUT(:lLMAX),'=')
472     
473           IF(lQ .EQ. 0) THEN
474              WRITE (*, 1001) trim(adjustl(INPUT))
475              WRITE(*, 1000)
476              CALL MFIX_EXIT(myPE)
477           ENDIF
478     
479     ! Convert the entrying into an double precision value.
480           READ(INPUT(lQ+1:),*,IOSTAT=IOS) lDH
481           IF(IOS .NE. 0) THEN
482              WRITE(*, 1002) trim(adjustl(INPUT))
483              WRITE(*, 1000)
484              CALL MFIX_EXIT(myPE)
485           ENDIF
486     
487     
488      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getDH',/               &
489              ' Error 1001: Input format error for DH.',//' INPUT: ',A)
490     
491      1002 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getDH',/               &
492              ' Error 1002: Unable to determine DH value from input.',/     &
493              ' Cannot convert specified value to double precision value.',/&
494              /' INPUT: ',A)
495     
496      1000 FORMAT(/' Please refer to the Readme file on the required input',&
497              ' format and make',/' the necessary corrections to the data', &
498              ' file.',/1X,70('*')//)
499     
500      1100 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
501              ' Error 1105: DH was initially located within the input line',&
502              /' however its location cannot be determined.',&
503              ' INPUT: ',A)
504     
505           RETURN
506           END SUBROUTINE getDH
507     
508     
509     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
510     !  Subroutine name: getfracDH(INPUT, lChemEq)                          !
511     !                                                                      !
512     !  Purpose: Extract the reaction name from a construct.                !
513     !                                                                      !
514     !  Variables referenced: None                                          !
515     !                                                                      !
516     !  Variables modified: None                                            !
517     !                                                                      !
518     !  Local variables: None                                               !
519     !                                                                      !
520     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
521           SUBROUTINE getFracDH(INPUT, lFracDH)
522     
523           USE param
524           USE param1
525     
526           IMPLICIT NONE
527     
528     ! Input line.
529           CHARACTER(len=*), INTENT(IN) :: INPUT
530     ! Name of reaction pulled from input.
531           DOUBLE PRECISION, INTENT(OUT) :: lFracDH(0:DIM_M)
532     
533     
534           INTEGER POS, lP, rP, lQ
535           INTEGER lLMAX
536     ! read/write output status
537           INTEGER IOS
538     ! Phase Index
539           INTEGER pIDX
540     
541           lLMAX = LEN_TRIM(INPUT)
542           POS = INDEX(INPUT,"FRACDH")
543     
544           IF(POS == 0) THEN
545              WRITE (*, 1100) trim(adjustl(INPUT))
546              WRITE(*, 1100)
547              CALL MFIX_EXIT(myPE)
548           ENDIF
549     
550           lP = INDEX(INPUT(:lLMAX),'(')
551           rP = INDEX(INPUT(:lLMAX),')')
552           lQ = INDEX(INPUT(:lLMAX),'=')
553     
554           IF(lP .EQ. rP .AND. lP .EQ. ZERO) THEN
555              WRITE(*, 1001) trim(adjustl(INPUT))
556              WRITE(*, 1000)
557              CALL MFIX_EXIT(myPE)
558           ELSEIF(lP .GE. rP) THEN
559              WRITE(*, 1002) trim(adjustl(INPUT))
560              WRITE(*, 1000)
561              CALL MFIX_EXIT(myPE)
562           ELSEIF(rP .GE. lQ) THEN
563              WRITE(*, 1002) trim(adjustl(INPUT))
564              WRITE(*, 1000)
565              CALL MFIX_EXIT(myPE)
566           ENDIF
567     ! Convert the entrying into an integer value.
568           READ(INPUT(lP+1:rP-1),*,IOSTAT=IOS) pIDX
569           IF(IOS .NE. 0) THEN
570              WRITE(*, 1003) trim(adjustl(INPUT))
571              WRITE(*, 1000)
572              CALL MFIX_EXIT(myPE)
573           ELSEIF(pIDX .LT. 0 .OR. pIDX .GT. DIM_M)THEN
574              WRITE(*, 1004) trim(adjustl(INPUT))
575              WRITE(*, 1000)
576              CALL MFIX_EXIT(myPE)
577           ENDIF
578     
579     ! Convert the entrying into an double precision value.
580           READ(INPUT(lQ+1:),*,IOSTAT=IOS) lFracDH(pIDX)
581           IF(IOS .NE. 0) THEN
582              WRITE(*, 1005)trim(adjustl(INPUT))
583              WRITE(*, 1000)
584              CALL MFIX_EXIT(myPE)
585           ENDIF
586     
587           RETURN
588     
589      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getFracDH',/           &
590              ' Error 1001: Unable to determine phase association for',     &
591              ' fracDH. When',/' specifying heat of reaction (DH), the',    &
592              ' fraction of DH assigned to',/' each phase must be',         &
593              ' given explicitly.',//' Example: fracDH(0) = 0.25  ! 25% of',&
594              ' DH is assigned to gas phase',/'          fracDH(1) = 0.75 ',&
595              ' ! 75% of DH is assigned to solids phase 1',//' Note:',      &
596              ' fracDH(0) + fracDH(1) + ... + frachDH(M) == 1.0',//         &
597              ' INPUT: ',A)
598     
599      1002 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getFracDH',/           &
600              ' Error 1002: Input format error for fracDH.',//              &
601              ' INPUT: ',A)
602     
603      1003 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getFracDH',/           &
604              ' Error 1003: Unable to determine phase index for fracDH.',//&
605              ' INPUT: ',A)
606     
607      1004 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getFracDH',/           &
608              ' Error 1004: Phase index for fracDH exceeds DIM_M!',//       &
609              ' INPUT: ',A)
610     
611      1005 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getFracDH',/           &
612              ' Error 1005: Unable to determine fracDH value from input.',/ &
613              ' Cannot convert specified value to double precision value.',/&
614              /' INPUT: ',A)
615     
616     
617      1000 FORMAT(/' Please refer to the Readme file on the required input',&
618              ' format and make',/' the necessary corrections to the data', &
619              ' file.',/1X,70('*')//)
620     
621      1100 FORMAT(//1X,70('*')/' From: PARSE_RXN',/                         &
622              ' Error 1105: fracDH was initially located within the',       &
623              ' input line,',/' however its location cannot be determined.',&
624              ' INPUT: ',A)
625     
626     
627     
628           END SUBROUTINE getFracDH
629     
630     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
631     !  Subroutine name: getChemEq(INPUT, lChemEq)                          !
632     !                                                                      !
633     !  Purpose: Extract the reaction name from a construct.                !
634     !                                                                      !
635     !  Variables referenced: None                                          !
636     !                                                                      !
637     !  Variables modified: None                                            !
638     !                                                                      !
639     !  Local variables: None                                               !
640     !                                                                      !
641     !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
642           SUBROUTINE getChemEq(IN, lChemEq)
643     
644           IMPLICIT NONE
645     
646     ! Input line.
647           CHARACTER(len=*), INTENT(IN) :: IN
648     ! Name of reaction pulled from input.
649           CHARACTER(len=*), INTENT(OUT) :: lChemEq
650     
651     ! read/write output status
652           INTEGER IOS
653     
654           INTEGER POS, lPOS, rPOS, ldP, lsP, aPOS
655           INTEGER lLMAX
656     
657     ! Chemical equations start with the keyword: CHEM_EQ. If this is not a
658     ! continuation of the previous line, search for the keyword and
659     ! flag an error if not found.
660           IF(.NOT.MORE_ChemEq) THEN
661              lLMAX = LEN_TRIM(IN)
662              POS = INDEX(IN,"CHEM_EQ")
663     
664              IF(POS == 0) THEN
665                 WRITE (*, 1105) 'Chem_Eq'
666                 CALL MFIX_EXIT(myPE)
667              ENDIF
668     ! Initialize
669              lChemEq = ''
670     ! Update POS to skip over the keyword: CHEM_EQ
671              POS = POS+7
672           ELSE
673              POS = 1
674           ENDIF
675     
676     ! Search for quote marks bounding the chemcial equation.
677           ldP = POS + INDEX(IN(POS:),'"')  ! double quote "
678           lsP = POS + INDEX(IN(POS:),"'")  ! single quote '
679     
680           IF(ldP .GT. POS .AND. lsP .EQ. POS) THEN
681     ! The chemical equation is bounded by double quotes
682              lPOS = ldP
683     ! Search for the second quote mark.
684              rPOS = lPOS + INDEX(IN(lPOS+1:),'"')
685           ELSEIF(ldP .EQ. POS .AND. lsP .GT. POS) THEN
686     ! The chemical equation is bounded by single quotes
687              lPOS = lsP
688     ! Search for the second quote mark.
689              rPOS = lPOS + INDEX(IN(lPOS+1:),"'")
690           ELSE
691     ! Different errors are thrown depending if this is a continuation
692     ! (MORE_ChemEq) or the start of a chemical equation.
693              IF(.NOT.MORE_ChemEq) THEN
694                 WRITE(*, 1001) trim(adjustl(IN))
695                 WRITE(*, 1000)
696              ELSE
697                 IF(isFracDH(IN)) THEN
698                   WRITE(*, 1002) 'Keyword fracDH was found inside',        &
699                      ' the chemcial equation!', trim(adjustl(IN))
700                   WRITE(*, 1000)
701                 ELSEIF(isDH(IN)) THEN
702                   WRITE(*, 1002) 'Keyword DH was found inside',            &
703                      ' the chemcial equation!', trim(adjustl(IN))
704                   WRITE(*, 1000)
705                 ELSE
706                   WRITE(*, 1002) 'Unbalanced or missing parentheses', '',  &
707                      trim(adjustl(IN))
708                   WRITE(*, 1000)
709                 ENDIF
710              ENDIF
711              CALL MFIX_EXIT(myPE)
712           ENDIF
713     
714     ! Mismatch/Unbalanced parentheses
715           IF(lPOS .EQ. rPOS) THEN
716     ! Different errors are thrown depending if this is a continuation
717     ! (MORE_ChemEq) or the start of a chemical equation.
718              IF(.NOT.MORE_ChemEq) THEN
719                 WRITE(*, 1001) trim(adjustl(IN))
720                 WRITE(*, 1000)
721              ELSE
722                WRITE(*, 1002) 'Unbalanced or missing parentheses', '',  &
723                   trim(adjustl(IN))
724                WRITE(*, 1000)
725              ENDIF
726              CALL MFIX_EXIT(myPE)
727           ENDIF
728     
729     ! Search for an ampersand.
730           aPOS = lPOS + INDEX(IN(lPOS+1:),'&')
731     ! An ampersand was found.
732           IF(aPOS .GT. lPOS) THEN
733              MORE_ChemEq = .TRUE.
734     ! The ampersand should be further to the right than the last quote mark.
735              IF(aPOS .LE. rPOS) THEN
736                 WRITE(*, 1003) trim(adjustl(IN))
737                 WRITE(*, 1000)
738                 CALL MFIX_EXIT(myPE)
739              ENDIF
740           ELSE
741              MORE_ChemEq = .FALSE.
742           ENDIF
743     
744     ! Store the chemical equation.
745           WRITE(lChemEq,"(A,1X,A)",IOSTAT=IOS) trim(lChemEq), &
746              trim(adjustl(IN(lPOS:rPOS-1)))
747           IF(IOS .NE. 0) THEN
748              WRITE(*, 1004) trim(lChemEq), trim(adjustl(IN))
749              WRITE(*, 1000)
750              CALL MFIX_EXIT(myPE)
751           ENDIF
752     
753           RETURN
754     
755      1001 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getChemEq',/           &
756              ' Error 1001: Unbalanced or missing parentheses for chem_eq.',&
757              //' INPUT: ',A,//' Example 1: RXN_NAME { chem_eq = ',         &
758              '"A + B --> AB" }',//' Example 2: RXN_NAME {',/14X,           &
759              'chem_eq = "A + B --> AB"',/14X, 'DH = 2.5d4',/14X,           &
760              'fracDH(0) = 1.0',/12X,'}')
761     
762      1002 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getChemEq',/           &
763              ' Error 1002: Chemcial equation continuation input error.',   &
764              //'  > ',2A//' INPUT: ',A)
765     
766      1003 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getChemEq',/           &
767              ' Error 1003: Input format error for chem_eq. An amperand',   &
768              ' (&)',/' was located within the parentheses.',//' INPUT: ',A)
769     
770      1004 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getChemEq',/           &
771              ' Error 1004: Unable to process chemical equation input.',/   &
772              ' A possible error is variable overflow as the total length', &
773              ' is limited',/' to 512 characters.',//' lChemEq: ',A,//      &
774              ' INPUT: ',A)
775     
776      1000 FORMAT(/' Please refer to the Readme file on the required input',&
777              ' format and make',/' the necessary corrections to the data', &
778              ' file.',/1X,70('*')//)
779     
780      1105 FORMAT(//1X,70('*')/' From: PARSE_RXN --> getChemEq',/           &
781              ' Error 1105: chem_eq was initially located within the',      &
782              ' input line,',/' however its location cannot be determined.',&
783              ' INPUT: ',A)
784     
785           END SUBROUTINE getChemEq
786     
787           END SUBROUTINE PARSE_RXN
788