************************************************************************ * 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