************************************************************************ * MASTER MECHANISM - ROUTINE NAME : hoadd_c7 * * * * * * PURPOSE : * * This subroutine compute the reaction rate for OH addition on * * O-C=C bond (case 7). Species having a C=O group conjugated with * * the C=C are not taken into account here * * * * 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 (C=C-C=C), otherwise =0 * * - cdtable(i) : carbon number bearing a "Cd" * * - cdeth(i) : carbon number bearing a "-O-" * * * * INPUT/OUTPUT * * - nr : number of reaction channel associated with chem * * - flag(i) : flag that active the 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_c7(chem,bond,group,ncd,cdtable,cdeth,conjug, & nr,flag,tarrhc,pchem,coprod) IMPLICIT NONE INCLUDE 'general.h' * input: CHARACTER(LEN=lfo) chem INTEGER bond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER ncd INTEGER conjug INTEGER cdtable(4) INTEGER cdeth(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,nc,nca,Ci,Cf,ic1,ic2 INTEGER tbond(mca,mca),nrg,ic INTEGER ring(mca),rngflg,p CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempkg CHARACTER(LEN=lco) tprod(mca) REAL fract(4),rtot 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) ! Initialize !------------- nca=0 Ci=0 Cf=0 nc=0 tempkg=' ' ic1=0 ic2=0 nip=0 DO i=1,4 fract(i)=0 ENDDO DO i=1,mca tgroup(i)=group(i) tprod(i)=' ' sc(i) = 0 rdckprod(i)=' ' DO j=1,mca tbond(i,j)=bond(i,j) rdcktprod(i,j)=' ' ENDDO ENDDO DO i=1,mca IF (tgroup(i).NE.'') THEN nca=nca+1 ENDIF ENDDO ! Find Ci and Cf such that Cdf=Cdi-O- DO 40 i=1,3,2 IF (cdtable(i).NE.0) THEN IF (cdeth(i,1).NE.0) THEN Ci=cdtable(i) Cf=cdtable(i+1) ic1=i ic2=i+1 ELSE IF (cdeth(i+1,1).NE.0) THEN Ci=cdtable(i+1) Cf=cdtable(i) ic1=i+1 ic2=i ELSE IF ((cdeth(i,1).EQ.0).AND.(cdeth(i+1,1).EQ.0)) THEN GOTO 40 ENDIF ! Check if there's a ring CALL findring(Ci,Cf,nca,bond,rngflg,ring) ! Because of a lack of kinetic data, it's assumed that the rate constant ! for all dihydrofurans is the same as C1H2CdH=Cd(CH3)-O-C1H2 ! For the moment, 50% for each channel ! C1H2CdH=Cd(CH3)-O-C1H2: 2.18E-10 IF (rngflg.EQ.1) THEN fract(ic1)=0.5 fract(ic2)=0.5 rtot=2.18E-10 ELSE IF (rngflg.NE.1) THEN fract(ic1)=0.5 fract(ic2)=0.5 rtot=7.3E-11 ENDIF ! -O-CH=CH2 (vinyl ether) ! In this case, the compound reacts like ethyl vinyl ether ! IF (nb.EQ.1) THEN ! rtot=1.01E-17 ! fract(Ci)=0.5 ! fract(Cf)=0.5 ! -O-CH=CH- or -O-C(C)=CH2 ! ELSE IF (nb.EQ.2) THEN ! IF (cdsub(ic2).EQ.1) THEN ! rtot=10E-18/1.15E-16*1.01E-17 ! fract(Ci)=0.5 ! fract(Cf)=0.5 ! ELSE ! rtot=10E-18/1.18E-17*1.01E-17 ! fract(Ci)=0.65 ! fract(Cf)=0.35 ! ENDIF ! -O-C(C)=CH- or -O-CH=C< ! ELSE IF (nb.EQ.3) THEN ! rtot=10E-18/3.48E-16*1.01E-17 ! IF ((cdsub(ic1).EQ.1).AND.(cdsub(ic2).EQ.2)) THEN ! fract(Ci)=0.70 ! fract(Cf)=0.30 ! ELSE IF ((cdsub(ic1).EQ.2).AND.(cdsub(ic2).EQ.1)) THEN ! fract(Ci)=0.30 ! fract(Cf)=0.70 ! ELSE ! WRITE(6,*) '-error in O3add_c7, no ratio found ' ! WRITE(99,*) 'o3add_c7',chem ! STOP ! ENDIF ! -O-C(C)=C< ! ELSE IF (nb.EQ.4) THEN ! rtot=10E-18/1.13E-15*1.01E-17 ! fract(Ci)=0.5 ! fract(Cf)=0.5 ! ENDIF ! Reaction !----------- ! Find the step for the loop IF (Ci.LT.Cf) THEN p=1 ELSE p=-1 ENDIF DO j=Ci,Cf,p ! Change the double bond into a single bond tbond(Cf,Ci)=1 tbond(Ci,Cf)=1 pold='Cd' pnew='C' tempkg=group(Ci) CALL swap(tempkg,pold,tgroup(Ci),pnew) tempkg=group(Cf) CALL swap(tempkg,pold,tgroup(Cf),pnew) ic=0 IF (j.EQ.Ci) THEN ic=ic1 ELSE IF (j.EQ.Cf) THEN ic=ic2 ELSE IF ((j.NE.Ci).OR.(j.NE.Cf)) THEN fract(ic)=0 ENDIF IF (fract(ic).GT.0.) THEN nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE:hoadd' WRITE(6,'(a)') 'too many reactions created for:' WRITE(6,'(a)') chem WRITE(99,*) 'hoadd_c7',chem STOP ENDIF flag(nr) = 1 tarrhc(nr,1) = rtot*fract(ic) tarrhc(nr,2) = 0 tarrhc(nr,3) = 0 ! Add OH to one carbon nc=INDEX(tgroup(j),' ') tgroup(j)(nc:nc+3)='(OH)' ! Add '.' to the other one IF (j.EQ.Ci) THEN nc=INDEX(tgroup(Cf),' ') tgroup(Cf)(nc:nc)='.' ELSE IF (j.EQ.Cf) THEN nc=INDEX(tgroup(Ci),' ') tgroup(Ci)(nc:nc)='.' ENDIF c DO k=1,mca c WRITE(6,*) tgroup(k) c ENDDO CALL rebond(tbond,tgroup,tempkg,nrg) c CALL radchk(tempkg,pchem(nr),tprod) CALL radchk(tempkg,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) IF (nip.NE.1) WRITE(6,*) '2 produits ho_addc7.f' DO k=1,mca coprod(nr,k) = rdcktprod(1,k) ENDDO ! Reset groups and bonds: DO k=1,mca tgroup(k) = group(k) DO l=1,mca tbond(k,l) = bond(k,l) tbond(l,k) = bond(l,k) ENDDO ENDDO ENDIF ENDDO ENDIF 40 CONTINUE ! exit case 7 RETURN END