!===========================================================
! SUBROUTINE : fragstd
! PURPOSE  : fragment, write in standard format
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE fragstd(bond2,group1,chema,chemb)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER,DIMENSION(mca,mca) :: bond2
      CHARACTER(LEN=lgr),DIMENSION(mca) :: group1
! output
      CHARACTER(LEN=lfo),INTENT(out) :: chema,chemb      
!--------------------------------------------------------------------

        CALL fragm(bond2,group1,chema,chemb)
        CALL stdchm(chema)
        CALL stdchm(chemb)

      END SUBROUTINE fragstd

!===========================================================
! SUBROUTINE : radstd
! PURPOSE  : check radicals, write in standard format
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE radstd(chema,tprod)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input/output
      CHARACTER(LEN=lfo) :: chema      
! output
      CHARACTER(LEN=lco),DIMENSION(mca) :: tprod
! local
      CHARACTER(LEN=lfo) :: tchem
      INTEGER        :: nip
      REAL,DIMENSION(mca) :: sc
!--------------------------------------------------------------------

        CALL radchk(chema,tchem,tprod,nip,sc)
        CALL stdchm(tchem)
        chema = tchem

      END SUBROUTINE radstd

!===========================================================
! SUBROUTINE : opnstd
! PURPOSE  : open ring, write in standard format
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE opnstd(bond2,group1,nring,chema,chemb,tprod)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER,DIMENSION(mca,mca) :: bond2
      CHARACTER(LEN=lgr),DIMENSION(mca) :: group1
! output
      INTEGER,INTENT(out) :: nring
      CHARACTER(LEN=lfo),INTENT(out) :: chema,chemb      
      CHARACTER(LEN=lco),DIMENSION(mca),INTENT(out) :: tprod
!--------------------------------------------------------------------

        CALL openr(bond2,group1,nring,chema,chemb,tprod)
        CALL stdchm(chema)
        CALL stdchm(chemb)

      END SUBROUTINE opnstd

!===========================================================
! SUBROUTINE : swapnrstd
! PURPOSE  : convert a group to a non-radical group, 
!            check, standardise formula
! CREATED  : Feb 2012, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE swapnrstd(i,gold,pold,pnew,gnew,
     &                   bond2,nring,chema)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER :: i
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gold
      CHARACTER(LEN=lgr) :: pold, pnew
      INTEGER,DIMENSION(mca,mca) :: bond2
! input/output
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gnew
! output
      INTEGER :: nring
      CHARACTER(LEN=lfo) :: chema
! internal
      CHARACTER(LEN=lfo) :: tchem
!--------------------------------------------------------------------

        CALL swap(gold(i),pold,gnew(i),pnew)
        CALL rebond(bond2,gnew,chema,nring)
        CALL stdchm(chema)

      END SUBROUTINE swapnrstd

!===========================================================
! SUBROUTINE : swapradstd
! PURPOSE  : convert a group to a radical group, 
!            check, find coproducts from radical, standardise formula
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE swapradstd(i,gold,pold,pnew,gnew,
     &                   bond2,nring,chema,coprod)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER :: i
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gold
      CHARACTER(LEN=lgr) :: pold, pnew
      INTEGER,DIMENSION(mca,mca) :: bond2
! input/output
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gnew
! output
      INTEGER :: nring
      CHARACTER(LEN=lfo) :: chema
      CHARACTER(LEN=lco),DIMENSION(mca,mca) :: coprod
! internal
      CHARACTER(LEN=lfo) :: tchem
      INTEGER        :: nip
      REAL,DIMENSION(mca) :: sc
!--------------------------------------------------------------------

        CALL swap(gold(i),pold,gnew(i),pnew)
        CALL rebond(bond2,gnew,chema,nring)
        CALL radchk(chema,tchem,coprod,nip,sc)
        chema = tchem
        CALL stdchm(chema)

      END SUBROUTINE swapradstd

!===========================================================
! SUBROUTINE : swapstd
! PURPOSE  : convert a group to a radical or non-radical group, 
!            check, find coproducts from radical, standardise formula
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE swapstd(i,gold,pold,pnew,gnew,
     &                   bond2,nring,chema,coprod)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER :: i
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gold
      CHARACTER(LEN=lgr) :: pold, pnew
      INTEGER,DIMENSION(mca,mca) :: bond2
! input/output
      CHARACTER(LEN=lgr),DIMENSION(mca) :: gnew
! output
      INTEGER :: nring
      CHARACTER(LEN=lfo) :: chema
      CHARACTER(LEN=lco),DIMENSION(mca,mca) :: coprod
! internal
      CHARACTER(LEN=lfo) :: tchem
      INTEGER        :: nip
      REAL,DIMENSION(mca) :: sc
!--------------------------------------------------------------------

        CALL swap(gold(i),pold,gnew(i),pnew)
        CALL rebond(bond2,gnew,chema,nring)
        IF(INDEX(chema,'.').NE.0)THEN
          CALL radchk(chema,tchem,coprod,nip,sc)
          chema = tchem
        ELSE
          coprod = coprod
        ENDIF
        CALL stdchm(chema)

      END SUBROUTINE swapstd

!===========================================================
! SUBROUTINE : fission
! PURPOSE  : break bond, add a dot to each side, fragment, check 
!            resulting radicals, write in standard format
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE fission(bond2,group1,x,y,pchem1d,coprod2d)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER :: x,y
      INTEGER,DIMENSION(mca,mca) :: bond2
      CHARACTER(LEN=lgr),DIMENSION(mca) :: group1
! output
      CHARACTER(LEN=lfo),DIMENSION(2) :: pchem1d
      CHARACTER(LEN=lco),DIMENSION(2,mca) :: coprod2d
! internal
      CHARACTER(LEN=lfo) :: tchem
      INTEGER        :: nip
      REAL,DIMENSION(mca) :: sc
!--------------------------------------------------------------------

        CALL setbond(bond2,x,y,0)
        CALL adddot(group1(y))
        CALL adddot(group1(x))

        CALL fragm(bond2,group1,pchem1d(1),pchem1d(2))
        CALL stdchm(pchem1d(1))
        CALL stdchm(pchem1d(2))

        CALL radchk(pchem1d(1),tchem,coprod2d(1,:),nip,sc)
        CALL stdchm(tchem)
        pchem1d(1) = tchem

        CALL radchk(pchem1d(2),tchem,coprod2d(2,:),nip,sc)
        CALL stdchm(tchem)
        pchem1d(2) = tchem

      END SUBROUTINE fission

!===========================================================
! SUBROUTINE : setbond
! PURPOSE  : set bond value
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!
! IN : x,y : bond coordinates 
! IN/OUT : bond : bond matrix 
!          val  : new value for bond
!===========================================================
      SUBROUTINE setbond(bond2,x,y,val)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      INTEGER :: x,y
      INTEGER :: val
! in/out
      INTEGER,DIMENSION(mca,mca) :: bond2
!--------------------------------------------------------------------

            bond2(x,y)=val
            bond2(y,x)=val

      END SUBROUTINE setbond

!===========================================================
! SUBROUTINE : adddot
! PURPOSE  : adds radical dot to group
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!
! IN/OUT : sgroup : single group
!===========================================================
      SUBROUTINE adddot(sgroup)

      IMPLICIT NONE
      INCLUDE 'general.h'

! in/out
      CHARACTER(LEN=lgr) :: sgroup
! local
      INTEGER :: nc
!--------------------------------------------------------------------
            nc = INDEX(sgroup,' ')
            sgroup(nc:nc) = '.'

      END SUBROUTINE adddot

!===========================================================
! SUBROUTINE : addreac
! PURPOSE : increment number of reactions, return error if too many 
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE addreac(nr,progname,chem,flag)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      CHARACTER(LEN=lsb) :: progname
      CHARACTER(LEN=lfo) :: chem
! in/out
      INTEGER :: nr
      INTEGER,DIMENSION(mnr) :: flag
      CHARACTER(LEN=ler) :: mesg
!--------------------------------------------------------------------
          nr = nr + 1
          IF (nr.GT.mnr) THEN
            mesg = 'too many reactions created for species'
            CALL errexit(progname,mesg,chem)
          ENDIF
          flag(nr) = 1

      END SUBROUTINE addreac

!===========================================================
! SUBROUTINE : addprod
! PURPOSE : increment number of products, return error if too many 
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!===========================================================
      SUBROUTINE addprod(np,progname,chem)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      CHARACTER(LEN=lsb) :: progname
      CHARACTER(LEN=lfo) :: chem
! in/out
      INTEGER :: np
      CHARACTER(LEN=ler) :: mesg
!--------------------------------------------------------------------
          np = np + 1
          IF (np.GT.mnp) THEN
      mesg = 'np > mnp (too many products in the reaction : addprod)'
            CALL errexit(progname,mesg,chem)
          ENDIF

      END SUBROUTINE addprod

!===========================================================
! SUBROUTINE : addcoprod
! PURPOSE : increment number of coproducts, return error if too many 
! CREATED  : July 2008, Julia Lee-Taylor, NCAR
!
!===========================================================
      SUBROUTINE addcoprod(np,progname,chem)

      IMPLICIT NONE
      INCLUDE 'general.h'

! input
      CHARACTER(LEN=lsb) :: progname
      CHARACTER(LEN=lfo) :: chem
! in/out
      INTEGER :: np
      CHARACTER(LEN=ler) :: mesg
!--------------------------------------------------------------------
          np = np + 1
          IF (np.GT.mnr) THEN
            mesg = 'np > mnr (too many coproducts for reaction)'
            CALL errexit(progname,mesg,chem)
          ENDIF

      END SUBROUTINE addcoprod

!=======================================================================
! SUBROUTINE : errexit
! PURPOSE: generates error message output
! CREATED: July 2008, Julia Lee-TAYLOR, NCAR
! INPUT:
!        prog : character : name of calling progoutine
!        mesg : character : nature of problem
!        chem : character : formula of species triggering error
!=======================================================================
      SUBROUTINE errexit(prog,mesg,chem)

      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'

! input:
      CHARACTER(LEN=lfo) :: chem
      CHARACTER(LEN=lsb) :: prog
      CHARACTER(LEN=ler) :: mesg

! local:
!      LOGICAL :: kill=.FALSE.
!      LOGICAL :: kill=.TRUE.

      PRINT*,"kill_fg = ",kill_fg

      WRITE(6,'(a)') '--error--'
      WRITE(6,'(a)') 'from GECKO-A ROUTINE : '//prog
      WRITE(6,'(a)') mesg
      WRITE(6,'(a)') chem

      WRITE(99,'(a)') '--error--'
      WRITE(99,'(a)') mesg
      WRITE(99,'(a)') prog,chem

      IF (kill_fg.NE.0) STOP

      RETURN
      END SUBROUTINE ERREXIT

!===========================================================

