************************************************************************
* MASTER MECHANISM - ROUTINE NAME : hoadd_c5                           *
*                                                                      *
*                                                                      *
* PURPOSE :                                                            *
*   This subroutine computes the reaction rate for OH addition to      *
*   >C=C-C=C-C=O bond (case 5) only.                                   *
*                                                                      *
*   The method used is the SAR of Peeters et al., 1997,                *
*   "kinetic studies of reactions of alkylperoxy and haloalkylperoxy   *
*   radicals with NO. A structure/reactivity relationship for reactions*
*   of OH with alkenes and polyalkenes", in Chemical processes in      *
*   atmospheric oxidation, Eurotrac, G. Le Bras (edt)                  *
*                                                                      *
*   Note: Only 1-2 and 1-4 addition are considered,                    *
*         those are treated as per hoadd_c1                            *
*                                                                      *
* INPUT:                                                               *
* - chem         : chemical formula                                    *
* - group(i)     : groups at position (carbon) i                       *
* - bond(i,j)    : carbon-carbon bond matrix of chem                   *
* - ncd          : number of "Cd" carbon in chem                       *
* - conjug       : =1 if conjugated Cd (in center of C=C-C=C)          *
* - cdtable(i)   : carbon number bearing a "Cd"                        *
* - cdcarbo(i,1) : carbon number bearing a C=O                         *
*                                                                      *
* INPUT/OUTPUT                                                         *
* - nr           : number of reaction channel associated with chem     *
* - flag(i)      : flag for active channel i                           *
* - tarrhc(i,3)  : arrhenius coefficient for channel i                 *
* - pchem(i)     : main organic product of reaction channel i          *
* - coprod(i,j)  : coproducts j of revation channel i                  *
*                                                                      *
*************************************************************************
      SUBROUTINE hoadd_c5(chem,bond,group,
     &                    ncd,conjug,cdtable,cdcarbo,
     &                    nr,flag,tarrhc,pchem,coprod,flag_del,
     &             pchem_del,coprod_del,sc_del)
      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'

* input:
      CHARACTER(LEN=lfo) chem
      INTEGER         bond(mca,mca)
      CHARACTER(LEN=lgr) group(mca)
      INTEGER         ncd, conjug
      INTEGER         cdtable(4)
      INTEGER         cdcarbo(4,2)

* input/output
      INTEGER         nr, flag(mnr)
      REAL            tarrhc(mnr,3)
      CHARACTER(LEN=lfo) pchem(mnr)
      CHARACTER(LEN=lco) coprod(mnr,mca)

* internal
      INTEGER         i,j,k,l,j0,j1,j2,j3, nc,nring,ialpha
      INTEGER         tbond(mca,mca)
      CHARACTER(LEN=lgr) tgroup(mca), pold, pnew
      CHARACTER(LEN=lfo) tempkc
      CHARACTER(LEN=lco) tprod(mca)
      REAL            w1,w2
      CHARACTER(LEN=lfo) rdckprod(mca),pchem_del(mnr)
      CHARACTER(LEN=lco) rdcktprod(mca,mca)
      INTEGER         nip,flag_del(mnr)
      CHARACTER(LEN=lco) coprod_del(mnr,mca)
      REAL            sc(mca),sc_del(mnr,mca)
      
      CHARACTER(LEN=lsb) :: progname='*hoadd_c5*   '
      CHARACTER(LEN=ler) :: mesg

* write info for finding bugs
      IF (wtflag.NE.0) WRITE(*,*) progname

* Initialize
* -----------
      tgroup(:)=group(:)
      tbond(:,:)=bond(:,:)
      ialpha=0
* from C3
* Note : in cdtable, 1-2 and 3-4 indexes of cdtable are double bonded.
* In cdtable, non 0 indexes are terminal carbon (must be at index 1 or 4)
* update : this routine is now used for -C=C-C=C-CO and for -C=C-C(CO)=C-
c      IF ( (cdcarbo(1,1).eq.0).and.(cdcarbo(4,1).eq.0) ) THEN
c        WRITE(6,'(a)') '--error--'
c        WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c5'
c        WRITE(6,'(a)') 'carbonyl expected at terminal position for'
c        WRITE(6,'(a)') chem
c        WRITE(99,*) 'hoadd_c5',chem !STOP
c      ENDIF

*********************************************************************
* add OH only at position furthest from carbonyl group (ialpha)
*********************************************************************
* define ialpha position (furthest from carbonyl group)
* ----------------
      IF ((cdcarbo(1,1).ne.0).OR.(cdcarbo(2,1).ne.0)) THEN
        ialpha = 4
      ELSE IF ((cdcarbo(4,1).ne.0).OR.(cdcarbo(3,1).ne.0)) THEN
        ialpha = 1
      ELSE
        WRITE(6,'(a)') '--error--'
        WRITE(6,'(a)')'from MASTER MECHANISM ROUTINE : hoadd_c5 '
        WRITE(6,'(a)') 'case 5 encountered but Carbonyl not found for'
        WRITE(6,'(a)') chem
        WRITE(99,*) 'hoadd_c5',chem !STOP
      ENDIF

      i=ialpha
      j0=cdtable(i)

      nr = nr + 1
      IF (nr.GT.mnr) THEN
        WRITE(6,'(a)') '--error--'
        WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c5'
        WRITE(6,'(a)') 'too many reactions created for species'
        WRITE(6,'(a)') chem
        WRITE(99,*) 'hoadd_c5',chem !STOP
      ENDIF
      flag(nr) = 1

* from C1
* find partner double-bond carbons (j1 is beta position, j2 is
* gamma position and j3 is delta position in C=C-C=C structure)
      j1 = 0
      j2 = 0
      j3 = 0
      IF (i.eq.1) THEN
        j1=cdtable(2)
        j2=cdtable(3)
        j3=cdtable(4)
      ELSE IF (i.eq.4) THEN
        j1=cdtable(3)
        j2=cdtable(2)
        j3=cdtable(1)
      ENDIF

* treat conjugated C=C-C=C bond
* -----------------------------
* assign rate constant for conjugated C=C bond (i.e radical formed
* is a C.-C=C structure) 
      IF (cdcarbo(i,1).NE.0) GOTO 610

      IF (group(j1)(1:3).eq.'CdH') THEN
        IF (group(j3)(1:4).eq.'CdH2') THEN
          tarrhc(nr,1)=3.0E-11
          w1=3./(0.45+3.)
          w2=0.45/(0.45+3.)
        ELSE IF (group(j3)(1:3).eq.'CdH') THEN
          tarrhc(nr,1)=3.75E-11
          w1=0.5
          w2=0.5
        ELSE IF (group(j3)(1:2).eq.'Cd') THEN
          tarrhc(nr,1)=5.05E-11
          w2=3./(3.+5.5)
          w1=5.5/(3.+5.5)
c          w2=5.5/(3.+5.5)
        ENDIF
      ELSE IF (group(j1)(1:2).eq.'Cd') THEN
        IF (group(j3)(1:4).eq.'CdH2') THEN
          tarrhc(nr,1)=5.65E-11
          w1=5.5/(0.45+5.5)
          w2=0.45/(0.45+5.5)
        ELSE IF (group(j3)(1:3).eq.'CdH') THEN
          tarrhc(nr,1)=8.35E-11
          w1=5.5/(3.+5.5)
          w2=3./(3.+5.5)
        ELSE IF (group(j3)(1:2).eq.'Cd') THEN
          tarrhc(nr,1)=9.85E-11
          w1=0.5
          w2=0.5
        ENDIF
      ENDIF

* check that a rate constant was set
      IF (tarrhc(nr,1).EQ.0.) THEN
        WRITE(6,'(a)') '--error--'
        WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c5'
        WRITE(6,'(a)') 'no rate constant set'
        WRITE(99,*) 'hoadd_c5',chem !STOP
      ENDIF

* FIRST RADICAL 
* set all value and rate constants
c      tarrhc(nr,1)=tarrhc(nr,1)*w1
      tarrhc(nr,2)=0.
      tarrhc(nr,3)=0.

* convert i to single bond carbon:
      tbond(j0,j1) = 1
      tbond(j1,j0) = 1
      pold = 'Cd'
      pnew = 'C'
      CALL swap(group(j0),pold,tgroup(j0),pnew)

* convert j1 to single bond C 
      pold = 'Cd'
      pnew = 'C'
      CALL swap(group(j1),pold,tgroup(j1),pnew)

* add (OH) to i carbon, add radical dot to j1:
      nc = INDEX(tgroup(j0),' ')
      tgroup(j0)(nc:nc+3) = '(OH)'
      nc = INDEX(tgroup(j1),' ')
      tgroup(j1)(nc:nc) = '.'

* rebuild, check, and find co-products:
      CALL rebond(tbond,tgroup,tempkc,nring)
      CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc)
      pchem(nr) = rdckprod(1)

      IF(nip.GT.1)THEN
        sc_del(nr,1) = w1
        sc_del(nr,2) = w2
        flag_del(nr) = 1
      ELSE
        sc_del(nr,1) = 1
        sc_del(nr,2) = 0
        flag_del(nr) = 0
      ENDIF

      pchem_del(nr) = rdckprod(2)
      CALL stdchm(pchem_del(nr))
      DO j=1,mca
        coprod_del(nr,j) = rdcktprod(2,j)
      ENDDO
      DO j=1,mca
         coprod(nr,j) = rdcktprod(1,j)
      ENDDO

* rename
      CALL stdchm(pchem(nr))
* reset groups,bonds:
      tbond(j0,j1) = bond(j0,j1)
      tbond(j1,j0) = bond(j1,j0)
      tgroup(j0)  = group(j0)
      tgroup(j1)  = group(j1)

c* SECOND RADICAL
c        
c      nr=nr+1
c      IF (nr.GT.mnr) THEN
c        WRITE(6,'(a)') '--error--'
c        WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c5'
c        WRITE(6,'(a)') 'too many reactions created for species'
c        WRITE(6,'(a)') chem
c        WRITE(99,*) 'hoadd_c5',chem !STOP
c      ENDIF
c      flag(nr) = 1
c        
c* set all value and rate constants (first reset the value)
c      tarrhc(nr,1)=tarrhc(nr-1,1)/w1
c      tarrhc(nr,1)=tarrhc(nr,1)*w2
c      tarrhc(nr,2)=0.
c      tarrhc(nr,3)=0.
c* convert i and j3 to single bond carbon:  
c      tbond(j0,j1) = 1
c      tbond(j1,j0) = 1
c      tbond(j2,j3) = 1
c      tbond(j3,j2) = 1
c
c* convert i to single bond C 
c      pold = 'Cd'
c      pnew = 'C'
c      CALL swap(group(j0),pold,tgroup(j0),pnew)
c
c* convert j3 to single bond C 
c      pold = 'Cd'
c      pnew = 'C'
c      CALL swap(group(j3),pold,tgroup(j3),pnew)
c
c* add (OH) to i carbon, add radical dot to j3 and change the
c* j1-j2 bond to a double bond:
c      nc = INDEX(tgroup(j0),' ')
c      tgroup(j0)(nc:nc+3) = '(OH)'
c      nc = INDEX(tgroup(j3),' ')
c      tgroup(j3)(nc:nc) = '.'
c      tbond(j1,j2) = 2
c      tbond(j2,j1) = 2
c
c* rebuild, check, and find co-products:
c      CALL rebond(tbond,tgroup,tempkc,nring)
c      CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc)
c      pchem(nr) = rdckprod(1)
c      IF (nip.NE.1) STOP 'hoadd_c5.f'
c      DO j=1,mca
c         coprod(nr,j) = rdcktprod(1,j)
c      ENDDO

* rename
c      CALL stdchm(pchem(nr))

610   CONTINUE
      END