parse_mod.f

Go to the documentation of this file.

MODULE parse

   USE compar
   USE exit, only: mfix_exit
   USE funits
   USE param
   USE param1

      IMPLICIT NONE

! Strings indicating arithmetic operation and reaction blocks.
      CHARACTER(LEN=2), PARAMETER :: start_str = '@('  ! start
      CHARACTER(LEN=1), PARAMETER :: end_str = ')'     ! end

! Strings indicating reaction blocks.
      CHARACTER(LEN=4), PARAMETER :: rxn_blk     = 'RXNS'      ! start block
      CHARACTER(LEN=8), PARAMETER :: des_rxn_blk = 'DES_RXNS'  ! start block
      CHARACTER(LEN=3), PARAMETER :: end_blk     = 'END'       ! end block

      LOGICAL reading_rxn
      LOGICAL reading_rate

      LOGICAL des_rxn
      LOGICAL tfm_rxn

! Logical indicating that the start of a reaction construct has
! been identified.
      LOGICAL in_construct

! Logical indicating that the chemical equation spans additional lines.
      LOGICAL more_chemeq

! Reaction names
      CHARACTER(len=32),  DIMENSION(:),   ALLOCATABLE :: rxn_name
! chemical Equations
      CHARACTER(len=512), DIMENSION(:),   ALLOCATABLE :: rxn_chem_eq
! User defined heat of reaction
      DOUBLE PRECISION,   DIMENSION(:),   ALLOCATABLE :: usrdh
! User defined heat of reaction partitions.
      DOUBLE PRECISION,   DIMENSION(:,:), ALLOCATABLE :: usrfdh


! Logical indicating that the start of a reaction construct has
! been identified.
      LOGICAL in_des_construct

! Reaction names
      CHARACTER(len=32),  DIMENSION(:),   ALLOCATABLE :: des_rxn_name
! chemical Equations
      CHARACTER(len=512), DIMENSION(:),   ALLOCATABLE :: des_rxn_chem_eq
! User defined heat of reaction
      DOUBLE PRECISION,   DIMENSION(:),   ALLOCATABLE :: des_usrdh
! User defined heat of reaction partitions.
      DOUBLE PRECISION,   DIMENSION(:,:), ALLOCATABLE :: des_usrfdh

      CONTAINS

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: setReaction                                          !
!                                                                      !
!  Purpose:                                                            !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!  Variables modified: None                                            !
!                                                                      !
!  Local variables: None                                               !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE setreaction(RxN, lNg, lSAg, lM, lNs, lSAs, lDH, lfDH)

      use rxn_com
      use toleranc

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Data structure for storing reaction data.
      TYPE(reaction_block), POINTER, INTENT(INOUT) :: RxN
! Number of gas speices
      INTEGER, INTENT(IN) :: lNg
! Gas phase species aliases
      CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
! Number of solids phases
      INTEGER, INTENT(IN) :: lM
! Number of species in each solids phase.
      INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
! Solids phase speices aliases.
      CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
! User defined heat of reaction.
      DOUBLE PRECISION, INTENT(IN) :: lDH
! User defined heat of reaction partition.
      DOUBLE PRECISION, DIMENSION(0:DIM_M), INTENT(IN) :: lfDH

! Local Variables:
!---------------------------------------------------------------------//
! Alias, phase, species, stoich coeff :: Reactants    Products
      CHARACTER(LEN=32), DIMENSION(50)     :: rAlias    ,  pAlias
      DOUBLE PRECISION, DIMENSION(50) :: rCoeff    ,  pCoeff

! Number of products and reactants
      INTEGER rNo, pNo
! Positions in ChemEq delineating the reactants and products.
      INTEGER rEnd, pStart
! Loop counters
      INTEGER L, LL, M, lN

! Sum of user specified heat of reaction partitions. If fracDH is set
! by the user, they must sum to one over all phases.
      DOUBLE PRECISION sumFDH
! Local storage for chemical equations, left-adjusted and trimmed
      CHARACTER(LEN=512) lChemEq
! Local storage for reaction name, left-adjusted and trimmed
      CHARACTER(LEN=32)  lName
! Logical indicating the reaction is skipped.
      LOGICAL Skip

      LOGICAL pMap(0:lm)

      INTEGER nSpecies, nPhases

      LOGICAL blankAlias(0:(dim_n_g + lm*dim_n_s))

! Initialize local reaction name and chemical equation variables.
      lname = trim(adjustl(rxn%Name))
      lchemeq = trim(adjustl(rxn%ChemEq))

      rxn%Classification = "Undefined"
      rxn%Calc_DH = .true.
      rxn%nSpecies = 0
      rxn%nPhases = 0

! Verify that the reactants are separated by --> or = signs. If the
! chemical equation is NONE, the reaction is skipped.
      CALL checksplit(lname, lchemeq, rend, pstart, skip)
      IF(skip) THEN
         rxn%nSpecies = 0
         RETURN
      ENDIF
! Set the flag to calculate heat of reaction.
      rxn%Calc_DH = .true.
      IF(ldh /= undefined) rxn%Calc_DH = .false.

! Pull off the reactants from the chemical equations.
      CALL splitentries(lname, lchemeq, 1, rend, rno, ralias, rcoeff)
! Pull off the products from the chemical equations.
      CALL splitentries(lname, lchemeq, pstart, len_trim(lchemeq),     &
         pno, palias, pcoeff)

      nspecies = rno + pno
      rxn%nSpecies = nspecies
      Allocate( rxn%Species( nspecies ))

      CALL checkblankaliases(lng, lsag, lm, lns, lsas, blankalias)

! Check that species in the chemical equation match a species alias
! in one of the phases.
      CALL mapaliases(lname, lchemeq, lng, lsag, lm, lns, lsas, rno,   &
         ralias, rcoeff, -one, 0, blankalias, rxn)

! Check that species in the chemical equation match a species alias
! in one of the phases.
      CALL mapaliases(lname, lchemeq, lng, lsag, lm, lns, lsas, pno,   &
         palias, pcoeff, one, rno, blankalias, rxn)

! All the relevant data has been collected at this point. Build the
! reaction block data structure.
      l = max(1,lm)
      ll = (l * (l-1)/2)
      Allocate( rxn%rPhase( ll+l ))


! Initialize local map and global values
      pmap(:) = .false.
      nphases = 0
      DO ln = 1, nspecies
         m = rxn%Species(ln)%pMap

         rxn%Species(ln)%mXfr = m
         rxn%Species(ln)%xXfr = zero

         IF(.NOT.pmap(m)) THEN
            pmap(m) = .true.
            nphases = nphases + 1
         ENDIF
      ENDDO
      rxn%nPhases = nphases

! Initialize sum of heat of reaction partitions.
      sumfdh = zero
! The user specified the heat of reaction.
      IF(.NOT.rxn%Calc_DH) THEN
! Allocate and initialize the heat of reaction storage array.
         Allocate( rxn%HoR( 0:lm ))
         rxn%HoR(:) = zero
         DO m=0,lm
! The phase is referenced by the reaction and heat of reaction is
! allocated (in part or fully) this this phase.
            IF(pmap(m) .AND. lfdh(m) .NE. undefined) THEN
! Store the heat of reaction.
               rxn%HoR(m) = lfdh(m) * ldh
               sumfdh = sumfdh + lfdh(m)
! The phase is not referenced by the reaction, but the heat of reaction
! is allocated (in part or fully) to this phase. Flag error and exit.
            ELSEIF(.NOT.pmap(m) .AND. lfdh(m) .NE. undefined) THEN
               IF(mype == pe_io) THEN
                  write(*,1000) trim(lname)
                  write(*,1001)
                  write(*,1010)
! Write message to log file.
                  write(unit_log,1000) trim(lname)
                  write(unit_log,1001)
                  write(unit_log,1010)
               ENDIF
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
         ENDDO
! Logical check: No partition was assigned to an undefined phase.
         DO m=lm+1,dim_m
            IF(.NOT.rxn%Calc_DH .AND. lfdh(m) .NE. undefined) THEN
               IF(mype == pe_io) THEN
                  write(*,1000) trim(lname)
                  write(*,1001)
                  write(*,1010)
! Write message to log file.
                  write(unit_log,1000) trim(lname)
                  write(unit_log,1001)
                  write(unit_log,1010)
! Exit MFIX
               ENDIF
               CALL mfix_exit(mype)
            ENDIF
         ENDDO
      ENDIF

! Verify that the heat of reaction partitions sum to one.
      IF(.NOT.rxn%Calc_DH .AND. .NOT. compare(sumfdh, one)) THEN
         IF(mype == pe_io) THEN
            write(*,1002) trim(lname)
            write(*,1010)
! Write message to log file.
            write(unit_log,1002) trim(lname)
            write(unit_log,1010)
! Exit MFIX
            CALL mfix_exit(mype)
         ENDIF
      ENDIF

      RETURN

 1000 FORMAT(/1x,70('*')/' From: From: setReaction:',/                 &
         ' Message: Heat of reaction is proportioned to a phase not',  &
         ' referenced',/' by the chemical equation for reaction ',a,'.')

 1001 FORMAT(/' If this is a catalytic reaction, reference one of the',&
         ' species of the',/' catalyst phase within the chemical',     &
         ' equation with a stoichiometric',/' coefficient of zero.'/)

 1002 FORMAT(/1x,70('*')/' From: From: setReaction:',/                 &
         ' Message: The heat of reaction partitions (fracDH) to all',  &
         ' phases do',/' not sum to one for reaction ',a,'.')

 1010 FORMAT(' Please refer to the Readme file for chemical equation', &
         ' input formats',/' and correct the data file.',/1x,70('*')/)


      END SUBROUTINE setreaction


!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: checkSplit                                           !
!                                                                      !
!  Purpose: Determine the location of reactatns and products within    !
!  the chemical equation. If the entry is NONE, flag that the reaction !
!  is to be skipped for further processing.                            !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!  Variables modified: None                                            !
!                                                                      !
!  Local variables: None                                               !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE checksplit(lName, lChemEq, lrEnd, lpStart, lSkip)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Chemical reaction name.
      CHARACTER(len=*), INTENT(IN) :: lName
! Chemical Equation from deck file.
      CHARACTER(len=*), INTENT(IN) :: lChemEq
! Position specifying the end of the reactants in lChemEq
      INTEGER, INTENT(OUT) :: lrEnd
! Position specifying the start of the products in lChemEq
      INTEGER, INTENT(OUT) :: lpStart
! If the chemical equation is NONE, the the skip flag is set to avoid
! further processing.
      LOGICAL, INTENT(OUT) :: lSkip

! Local Variables:
!---------------------------------------------------------------------//
! Position of the head (>) and tail (-) of an arror (-->)
      INTEGER hArr, tArr
! Postion of the head and tail of equal signs (=, ==, ===, ...)
      INTEGER hEqs, tEqs
! Position of the head/tail of a reverse arrow (<--)
      INTEGER hRArr, tRArr
! A flag generated to point out the location of the entry error.
      CHARACTER(LEN=512) FLAG
      flag = ''

! If the chemical equation is set to 'none', then the reaction is
! skipped for the simulation.
      lskip = .false.
      IF(index(lchemeq,'NONE') > 0) THEN
         lskip = .true.
         lrend = undefined_i
         lpstart = undefined_i
         RETURN
      ENDIF

! Search for > (part of -->) and search for < (part of <--)
      tarr = index(lchemeq,'-', back=.false.)
      harr = index(lchemeq,">", back=.true.)
! Search for the first and last instances of equal signs.
      teqs = index(lchemeq,"=", back=.false.)
      heqs = index(lchemeq,"=", back=.true.)
! Search for < (as part of <-- or <-->). Illegal chemical equation.
      hrarr = index(lchemeq,"<", back=.false.)
      trarr = index(lchemeq,"-", back=.true.)

! An illegal arrow was found! Flag error and exit.
      IF(hrarr > 0) THEN
         IF(mype == pe_io) THEN
! Construct the error flag.
            IF(harr > 0) THEN
               flag = setflag(20, hrarr, harr)
            ELSEIF(trarr > 0) THEN
               flag = setflag(20, hrarr, trarr)
            ELSE
               flag = setflag(20, hrarr)
            ENDIF
! Write the message to the screen.
            write(*,1000) trim(lname)
            write(*,1002)'Illegal'
            write(*,1010) trim(lchemeq), trim(flag)
            write(*,1001)
! Write message to log file.
            write(unit_log,1000) trim(lname)
            write(unit_log,1002)'Illegal'
            write(unit_log,1010) trim(lchemeq), trim(flag)
            write(unit_log,1001)
! Exit MFIX
            CALL mfix_exit(mype)
         ENDIF
      ENDIF
! If there are more than one operator, flag error and exit.
      IF(harr /= 0 .AND. heqs /= 0) THEN
         IF(mype == pe_io) THEN
! Construct the error flag.
            flag = setflag(20, harr, heqs)
! Write the message to the screen.
            write(*,1000) trim(lname)
            write(*,1002)'Too many'
            write(*,1010) trim(lchemeq), trim(flag)
            write(*,1001)
! Write message to log file.
            write(unit_log,1000) trim(lname)
            write(unit_log,1002)'Too many'
            write(unit_log,1010) trim(lchemeq), trim(flag)
            write(unit_log,1001)
! Exit MFIX
            CALL mfix_exit(mype)
         ENDIF
! If there is no operator (--> or =), flag error and exit.
      ELSEIF(harr == 0 .AND. heqs == 0) THEN
         IF(mype == pe_io) THEN
            write(*,1000) trim(lname)
            write(*,1002) 'No'
            write(*,1011) trim(lchemeq)
            write(*,1001)
! Write message to log file.
            write(unit_log,1000) trim(lname)
            write(unit_log,1002) 'No'
            write(unit_log,1011) trim(lchemeq)
            write(unit_log,1001)
! Exit MFIX
            CALL mfix_exit(mype)
         ENDIF
! The head of an arrow was found.
      ELSEIF(harr /= 0) THEN
! Verify that a tail was found.
         IF(tarr == 0) THEN
! Construct the error flag.
            flag = setflag(20, harr)
            IF(mype == pe_io) THEN
               write(*,1000) trim(lname)
               write(*,1003) 'Missing the tail; -->'
               write(*,1010) trim(lchemeq), trim(flag)
               write(*,1001)
! Write message to log file.
               write(unit_log,1000) trim(lname)
               write(unit_log,1003) 'Missing the tail; -->'
               write(unit_log,1010) trim(lchemeq), trim(flag)
               write(unit_log,1001)
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
         ELSEIF(tarr > harr) THEN
            IF(mype == pe_io) THEN
               flag = setflag(20, harr, index(lchemeq,'-',back=.true.))
               write(*,1000) trim(lname)
               write(*,1003) 'Arror head preceeds the tail; -->'
               write(*,1010) trim(lchemeq), trim(flag)
               write(*,1001)
! Write message to log file.
               write(unit_log,1000) trim(lname)
               write(unit_log,1003) 'Arror head preceeds the tail; -->'
               write(unit_log,1010) trim(lchemeq), trim(flag)
               write(unit_log,1001)
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
         ELSE
! An arror was used to seperate reactants and products. Send back the
! ending index of reactants and the starting index for products.
            lrend = tarr - 1
            lpstart = harr + 1
         ENDIF
! Equals sign(s) were used to specify the reaction. Send back the ending
! index of reactants and the starting index for products.
      ELSEIF(heqs /= 0) THEN
         lrend = teqs - 1
         lpstart = heqs + 1
! Fatal Error. One of the above checks should have caught any problems
! and sent out an error message.
      ELSE
         IF(mype == pe_io) THEN
            write(*,1000) trim(lname)
            write(*,1004)
            write(*,1011) trim(lchemeq)
            write(*,1001)
! Write message to log file.
            write(unit_log,1000) trim(lname)
            write(unit_log,1004)
            write(unit_log,1010) trim(lchemeq), trim(flag)
            write(unit_log,1001)
! Exit MFIX
            CALL mfix_exit(mype)
         ENDIF
      ENDIF

      RETURN

 1000 FORMAT(/1x,70('*')/' From: From: setReaction --> checkSplit',/   &
         ' Message: Error in determining the reactants and products',  &
         ' in the',/' chemical equation for reaction ',a,'.')

 1001 FORMAT(' Please refer to the Readme file for chemical equation', &
         ' input formats',/' and correct the data file.',/1x,70('*')/)

 1002 FORMAT(/1x,a,' operators were found!')

 1003 FORMAT(' Incorrect operator format! ',a)

 1004 FORMAT(' FATAL ERROR: All logical checks failed.')

 1010 FORMAT(/' Chemical Equation: ',a,/1x, a/)

 1011 FORMAT(/' Chemical Equation: ',a,/)


      END SUBROUTINE checksplit


!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: splitEntries()                                       !
!                                                                      !
!  Purpose: Takes a string of either reactants or products and splits  !
!  the string into individual species/stoichiometric entries.          !
!                                                                      !
!  A call to splitAliasAndCoeff is made to further split the entries   !
!  into species aliases and matching stoichiometric coefficients.      !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE splitentries(lName, lChemEq, lStart, lEnd, lNo,       &
         lalias, lcoeff)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Chemical reaction name.
      CHARACTER(len=*), INTENT(IN) :: lName
! Chemical Equation.
      CHARACTER(len=*), INTENT(IN) :: lChemEq
! Starting position for substring analysis.
      INTEGER, INTENT(IN) :: lStart
! Ending position for substring analysis.
      INTEGER, INTENT(IN) :: lEnd
! The number of individual species found in lSpecies.
      INTEGER, INTENT(OUT) :: lNo
! Species Aliases from the chemical equation.
      CHARACTER(LEN=32), DIMENSION(50), INTENT(OUT) :: lAlias
! Stoichiometric coefficient pulled from the chemical equation.
      DOUBLE PRECISION, DIMENSION(50), INTENT(OUT) :: lCoeff

! Local Variables:
!---------------------------------------------------------------------//
! Flag indicating that there are more entries to process.
      LOGICAL MORE
! Starting position for left-to-right search.
      INTEGER lPOS
! Position of plus sign charachter found in search.
      INTEGER rPOS

! Initialize storage variables.
      lno = 0
      lalias(:) = ''
      lcoeff(:) = undefined

! Initialiase local variables.
      lpos = lstart
      more = .true.
! Loop through the string, splitting entries separated by a plus sign.
      DO WHILE(more)
! Increment the species counter.
         lno = lno + 1
! Locate the plus sign. (Left to right)
         rpos = (lpos-1) + index(lchemeq(lpos:lend),"+", back=.false.)
! A plus sign was found.
         IF(rpos .GT. lpos) THEN
! Extract the entry and split it into the species alias and
! stoichiometric coefficient.
            CALL splitaliasandcoeff(lname, lchemeq, lpos, rpos-1,      &
               lalias(lno), lcoeff(lno))
! Indicate that there are more entries to process.
            more = .true.
! No plus sign was found. This is the last entry.
         ELSE
! Extract the entry and split it into the species alias and
! stoichiometric coefficient.
            CALL splitaliasandcoeff(lname, lchemeq, lpos, lend,        &
               lalias(lno), lcoeff(lno))
! Indicate that there are no more entries to process.
            more = .false.
         ENDIF
! Move past the found plus sign for next search.
         lpos = rpos + 1
      ENDDO

      RETURN
      END SUBROUTINE splitentries

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: splitAliasAndCoeff()                                 !
!                                                                      !
!  Purpose: Take a string containing a species alias and stoichio-     !
!  metric coefficient and splits them into their respective parts.     !
!                                                                      !
!  If no numerical coefficient is found, it is set to one.             !
!                                                                      !
!  If present, asterisks (*) are assumed to seperate numerical         !
!  coefficients and the species alias. If more than one asterisk is    !
!  found, and error is reported and MFIX_EXIT is called.               !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE splitaliasandcoeff(lName, lChemEq, lStart, lEnd,      &
         lalias, lcoeff)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Chemical reaction name.
      CHARACTER(len=*), INTENT(IN) :: lName
! Chemical Equation.
      CHARACTER(len=*), INTENT(IN) :: lChemEq
! Starting position for substring analysis.
      INTEGER, INTENT(IN) :: lStart
! Ending position for substring analysis.
      INTEGER, INTENT(IN) :: lEnd
! Species Aliases from the chemical equation.
      CHARACTER(LEN=32), INTENT(OUT) :: lAlias
! Stoichiometric coefficient pulled from the chemical equation.
      DOUBLE PRECISION, INTENT(OUT) :: lCoeff

! Local Variables:
!---------------------------------------------------------------------//
! Flag
      LOGICAL MATCH
      INTEGER nPOS

      INTEGER L, N, IOS, aPOS, a2POS

      CHARACTER(LEN=12), PARAMETER :: Numbers = '.0123456789'

! A flag generated to point out the location of the entry error.
      CHARACTER(LEN=512) FLAG
      flag = ''

! Locate the first asterisk (if any). Search left-to-right.
      apos = index(lchemeq(lstart:lend),"*", back=.false.)
! An asterisk was found.
      IF(apos .GT. zero) THEN
! Make sure that there isn't another asterisk further down the string.
         a2pos = index(lchemeq(lstart:lend),"*", back=.true.)
         IF(apos /= a2pos) THEN
            IF(mype == pe_io) THEN
! Construct the error flag.
               flag = setflag(20, lstart+apos, lstart+a2pos)
! Write the message to the screen.
               write(*,1000) trim(lname)
               write(*,1002)'Too many'
               write(*,1010) trim(lchemeq), trim(flag)
               write(*,1001)
! Write message to log file.
               write(unit_log,1000) trim(lname)
               write(unit_log,1002)'Too many'
               write(unit_log,1010) trim(lchemeq), trim(flag)
               write(unit_log,1001)
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
         ELSE
! Store left-of-asterisk as the coefficient. If an error occurs in
! converting the string to double precision, flag the problem and
! call MFIX_EXIT.
            READ(lchemeq(lstart:(lstart+apos-2)),*,iostat=ios) lcoeff
            IF(ios .NE. 0 .AND. mype == pe_io) THEN
! Construct the error flag.
               flag = setflag(20, lstart + int(apos/2))
! Write the message to the screen.
               write(*,1000) trim(lname)
               write(*,1010) trim(lchemeq), trim(flag)
               write(*,1001)
! Write message to log file.
               write(unit_log,1000) trim(lname)
               write(unit_log,1010) trim(lchemeq), trim(flag)
               write(unit_log,1001)
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
! Store right-of-asterisk as the species alias.
            WRITE(lalias,"(A)") &
               trim(adjustl(lchemeq((lstart+apos):lend)))
         ENDIF
! If no asterisk was found, search for numbers and spaces.
      ELSE
! Initialize the position of last consecutive number.
         npos = 0
! In a left-to-right search, check if the characters in the entry are
! numbers or punctuation.
         DO l=lstart,lend
            match = .false.
            DO n=1,12
               IF(lchemeq(l:l) /= numbers(n:n)) cycle
! Note the position of the number.
               npos = l
! Flag that a match was made.
               match = .true.
            ENDDO
! If no match, assume the end of the coefficient was found.
            IF(.NOT.match) EXIT
         ENDDO
! If no numbers or punctuation was found, assumed the stoichiometric
! coefficient is one.
         IF(trim(lchemeq(lstart:npos)) =='') THEN
            lcoeff = 1.0d0
         ELSE
! If leading numbers were found, store as the stoich-coeff.
            READ(lchemeq(lstart:npos),*,iostat=ios) lcoeff
! Report any problems in converting the string to double precision.
            IF(ios .NE. 0 .AND. mype == pe_io) THEN
! Construct the error flag.
               flag = setflag(20, &
                  lstart+int(len_trim(lchemeq(lstart:npos))/2))
! Write the message to the screen.
               write(*,1000) trim(lname)
               write(*,1010) trim(lchemeq), trim(flag)
               write(*,1001)
! Write message to log file.
               write(unit_log,1000) trim(lname)
               write(unit_log,1010) trim(lchemeq), trim(flag)
               write(unit_log,1001)
! Exit MFIX
               CALL mfix_exit(mype)
            ENDIF
         ENDIF
! Store right-of-coefficient as the species alias.
         READ(lchemeq(npos+1:lend),*,iostat=ios) lalias
      ENDIF
! Quick check to make sure that the species alias is not empty.
      IF(len_trim(lalias) == 0 .AND. mype == pe_io) THEN
! Construct the error flag.
         flag = setflag(20, lstart + int(lend/2))
! Write the message to the screen.
         write(*,1003) trim(lname)
         write(*,1010) trim(lchemeq), trim(flag)
         write(*,1001)
! Write message to log file.
         write(unit_log,1003) trim(lname)
         write(unit_log,1010) trim(lchemeq), trim(flag)
         write(unit_log,1001)
! Exit MFIX
         CALL mfix_exit(mype)
      ENDIF

      RETURN

 1000 FORMAT(/1x,70('*')/' From: From: setReaction -->',               &
         ' splitAliasAndCoeff',/' Message: Error determining the',     &
         ' stoichiometric coefficient in the',/' chemical equation',   &
         ' for reaction ',a,'.')


 1001 FORMAT(' Please refer to the Readme file for chemical equation', &
         ' input formats',/' and correct the data file.',/1x,70('*')/)

 1002 FORMAT(/1x,a,' operators were found!')

 1003 FORMAT(/1x,70('*')/' From: From: setReaction -->',               &
         ' splitAliasAndCoeff',/' Message: Error determining the',     &
         ' speices in the chemical equation for',/' reaction ',a,'.'/)

 1010 FORMAT(/' Chemical Equation: ',a,/1x, a/)

 1011 FORMAT(/' Chemical Equation: ',a,/)

      END SUBROUTINE splitaliasandcoeff

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: checkBlankAliases()                                  !
!                                                                      !
!  Purpose: Take a string containing a species alias and stoichio-     !
!  metric coefficient and splits them into their respective parts.     !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE checkblankaliases(lNg, lSAg, lM, lNs, lSAs, lBA)

      IMPLICIT NONE

! Number of gas speices
      INTEGER, INTENT(IN) :: lNg
! Gas phase species aliases
      CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
! Number of solids phases
      INTEGER, INTENT(IN) :: lM
! Number of species in each solids phase.
      INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
! Solids phase speices aliases.
      CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs

      LOGICAL, INTENT(OUT) :: lBA(0:(dim_n_g + lm*dim_n_s))

      INTEGER M, N

! Loop counter for continuum and discrete species
      INTEGER Nsp

! Initialize counters
      nsp = 0

      lba(0) = .false.
      DO n = 1, lng
         nsp = nsp + 1
         lba(nsp) = .false.
         IF(len_trim(lsag(n)) == 0) THEN
            lba(nsp) = .true.
            lba(0) = .true.
         ENDIF
      ENDDO

! Compare aliaes between solids phases
      DO m = 1, lm
         DO n = 1, lns(m)
            nsp = nsp + 1
            lba(nsp) = .false.
            IF(len_trim(lsas(m,n)) == 0) THEN
               lba(nsp) = .true.
               lba(0) = .true.
            ENDIF
         ENDDO
      ENDDO

      RETURN
      END SUBROUTINE checkblankaliases

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: mapAliases()                                         !
!                                                                      !
!  Purpose: Take a string containing a species alias and stoichio-     !
!  metric coefficient and splits them into their respective parts.     !
!                                                                      !
!  If no numerical coefficient is found, it is set to one.             !
!                                                                      !
!  If present, asterisks (*) are assumed to seperate numerical         !
!  coefficients and the species alias. If more than one asterisk is    !
!  found, and error is reported and MFIX_EXIT is called.               !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE mapaliases(lName, lChemEq, lNg, lSAg, lM, lNs, lSAs,  &
         lno, lalias, lcoeff, lsgn, lstart, lba, lrxn)

      use rxn_com

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Chemical reaction name.
      CHARACTER(len=*), INTENT(IN) :: lName
! Chemical Equation.
      CHARACTER(len=*), INTENT(IN) :: lChemEq
! Number of gas speices
      INTEGER, INTENT(IN) :: lNg
! Gas phase species aliases
      CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
! Number of solids phases
      INTEGER, INTENT(IN) :: lM
! Number of species in each solids phase.
      INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
! Solids phase speices aliases.
      CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
! Number of products (or reactants)
      INTEGER, INTENT(IN) :: lNo
! Species Alaises pulled from the chemical equation.
      CHARACTER(LEN=32), DIMENSION(50), INTENT(IN) :: lAlias

      DOUBLE PRECISION, DIMENSION(50), INTENT(IN) :: lCoeff

      DOUBLE PRECISION, INTENT(IN) :: lSgn

      INTEGER, INTENT(IN) :: lStart

      LOGICAL, INTENT(IN) :: lBA(0:(dim_n_g + lm*dim_n_s))

! Data structure for storing reaction data.
      TYPE(reaction_block), POINTER, INTENT(INOUT) :: lRxN


! Local Variables:
!---------------------------------------------------------------------//
! Loop counters.
      INTEGER L, M, NN
! A flag generated to point out the location of the entry error.
      CHARACTER(LEN=512) FLAG
! Location in string to locate error.
      INTEGER lPOS, rPOS

! Initialize the error flag.
      flag = ''

! Loop over the number of (reactants/products)
      aloop : DO l=1, lno
! Compare entry with gas phase species.
         DO nn = 1, lng
            IF( checkmatch(lsag(nn), lalias(l))) THEN
               lrxn%Species(lstart + l)%pMap = 0
               lrxn%Species(lstart + l)%sMap = nn
               lrxn%Species(lstart + l)%Coeff = lsgn * lcoeff(l)
               cycle aloop
            ENDIF
         ENDDO
! Compare entry with solids phase species.
         DO m = 1, lm
            DO nn = 1, lns(m)
               IF(checkmatch(lsas(m,nn),lalias(l))) THEN
                  lrxn%Species(lstart + l)%pMap = m
                  lrxn%Species(lstart + l)%sMap = nn
                  lrxn%Species(lstart + l)%Coeff = lsgn * lcoeff(l)
                  cycle aloop
               ENDIF
            ENDDO
         ENDDO
! No matching species was located. Flag an error and exit.
         IF(mype == pe_io) THEN
! Construct the error flag.
            lpos = index(lchemeq,trim(lalias(l)), back=.false.)
            rpos = index(lchemeq,trim(lalias(l)), back=.true.)
            flag = setflag(20, 1 + int((lpos + rpos)/2))
! Write the message to the screen.
            write(*,1000) trim(lalias(l)), trim(lname)
            write(*,1010) trim(lchemeq), trim(flag)
            IF(lba(0)) CALL writeba()
            write(*,1001)
! Write message to log file.
            write(unit_log,1000) trim(lalias(l)), trim(lname)
            write(unit_log,1010) trim(lchemeq), trim(flag)
            IF(lba(0)) CALL writeba(unit_log)
            write(unit_log,1001)
         ENDIF
! Exit MFIX
         CALL mfix_exit(mype)

      ENDDO aloop

      RETURN

 1000 FORMAT(/1x,70('*')/' From: From: setReaction --> mapAliases',/   &
         ' Message: Unable to match species ',a,' in the chemical',    &
         ' equation for ',/' reaction ',a,'.')

 1001 FORMAT(/' Please refer to the Readme file for chemical equation',&
         ' input formats',/' and correct the data file.',/1x,70('*')/)

 1010 FORMAT(/' Chemical Equation: ',a,/1x, a/)

 1011 FORMAT(/' Chemical Equation: ',a,/)


      contains

!......................................................................!
!  Function name: checkMatch                                           !
!                                                                      !
!  Purpose: Takes two species aliases as arguments, converts them to   !
!  uppercase and checks if they match.                                 !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!......................................................................!
      LOGICAL FUNCTION checkmatch(lSA, ceSA)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
      CHARACTER(LEN=32), INTENT(IN) :: lSA, ceSA

! Local Variables:
!---------------------------------------------------------------------//
      CHARACTER(LEN=32) tlSA

! Copy species alias.
      tlsa = lsa
! Remove case sensitivity.
      CALL make_upper_case (tlsa,32)
! Compare the two strings.
      checkmatch = .false.
      IF(trim(tlsa) == trim(cesa)) checkmatch = .true.
      RETURN
      END FUNCTION checkmatch

!......................................................................!
!  Function name: updateMap                                            !
!                                                                      !
!  Purpose: Flags that the passed phase is part of the chemical        !
!  reaction. If the phase was not already noted, the number of phases  !
!  in the reaction is increased and the flag set true. Additionally,   !
!  The number of species (either product or reactant) for the phase    !
!  is incremented.                                                     !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!......................................................................!
      SUBROUTINE updatemap(lnP, lpMap, llNoP)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
      INTEGER, INTENT(INOUT) :: lnP
! Map of phases for the reaction.
      LOGICAL, INTENT(INOUT) :: lpMap
      INTEGER, INTENT(INOUT) :: llNoP

! Local Variables:
!---------------------------------------------------------------------//
! None

! Increment the number of reactants/products this phase has involved in
! the current reaction.
      llnop = llnop + 1
! If the phase was already identified, return.
      IF(lpmap) RETURN
! If this is the first time the phase is identififed, set the flag to
! true and increment the total number of phases in the reaction.
      lnp = lnp + 1
      lpmap = .true.

      RETURN
      END SUBROUTINE updatemap


!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: writeBA()                                            !
!                                                                      !
!  Purpose: Print out which species were not given aliases.            !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      SUBROUTINE writeba(FUNIT)

      IMPLICIT NONE

! File unit
      INTEGER, OPTIONAL, INTENT(IN) :: FUNIT

      INTEGER M, N

! Loop counter for continuum and discrete species
      INTEGER Nsp

      IF(.NOT.PRESENT(funit)) THEN
         write(*,1000)
      ELSE
         write(funit,1000)
      ENDIF

! Initialize counters
      nsp = 0

      DO n = 1, lng
         nsp = nsp + 1
         IF(lba(nsp)) THEN
            IF(.NOT.PRESENT(funit)) THEN
               write(*,1001)n
            ELSE
               write(funit,1001) n
            ENDIF
         ENDIF
      ENDDO

! Compare aliaes between solids phases
      DO m = 1, lm
         DO n = 1, lns(m)
            nsp = nsp + 1

            IF(lba(nsp)) THEN
               IF(.NOT.PRESENT(funit)) THEN
                  write(*,1002)m, n
               ELSE
                  write(funit,1002)m, n
               ENDIF
            ENDIF
         ENDDO
      ENDDO

      RETURN

 1000 FORMAT(' Species aliases were not provided for the following:')
 1001 FORMAT(3x, ' Gas phase species ',i2)
 1002 FORMAT(3x, ' Solid phase ',i2,' specie ',i2)

      END SUBROUTINE writeba

      END SUBROUTINE mapaliases


!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!  Function name: setFlag                                              !
!                                                                      !
!  Purpose: Creates a flag pointing to a particular string location.   !
!                                                                      !
!  Variables referenced: None                                          !
!                                                                      !
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
      CHARACTER(len=512) FUNCTION setflag(fill, flg1, flg2) RESULT(OUT)

      IMPLICIT NONE

! Pass Arguments:
!---------------------------------------------------------------------//
! Number of leading spaces to fill with dashes. This is used to jump
! past any lead-in text.
      INTEGER, INTENT(IN) :: fill
! Location in string to place the pointer.
      INTEGER, INTENT(IN) :: flg1
! Optional - location of second pointer in string
      INTEGER, INTENT(IN), OPTIONAL :: flg2

! Local Variables:
!---------------------------------------------------------------------//
      INTEGER L, FILL1, FILL2

! Create a string with "FILL" dash characters.
      out = ''
      DO l = 1, fill-1
         WRITE(out,"(A,A)") trim(out), '-'
      ENDDO

! If a second pointer is present, determined the larger of the two.
      IF(PRESENT(flg2)) THEN
         IF(flg1 < flg2) THEN
            fill1 = flg1 - 1
            fill2 = (flg2-flg1) - 1
         ELSE
            fill1 = flg2 - 1
            fill2 = (flg1-flg2) - 1
         ENDIF
      ELSE
         fill1 = flg1 - 1
         fill2 = 0
      ENDIF

! Fill with dashes up to the the first pointer. ----^
      DO l = 1, fill1
         WRITE(out,"(A,A)") trim(out), '-'
      ENDDO
      WRITE(out,"(A,A)") trim(out), '^'
! Fill with dashes up to the second pointer. ----^---^
      IF(fill2 > 0) THEN
         DO l = 1, fill2
            WRITE(out,"(A,A)") trim(out), '-'
         ENDDO
         WRITE(out,"(A,A)") trim(out), '^'
      ENDIF

      END FUNCTION setflag

END MODULE parse