************************************************************************ * MASTER MECHANISM - ROUTINE NAME : o3add_c7 * * * * * * PURPOSE : * * This subroutine computes the reaction rate for O3 addition to * * -C=C-O- structures (case 7). * * It is assumed for the moment that only one -O- group is considered * * for each double bond * * * * The 2 reaction products (carbonyl and criegge) are returned as * * pchem(i,1) and pchem(i,2). * * * * INPUT: * * - chem : chemical formula * * - group(i) : groups at position 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" * * - cdsub(i) : number of -C- substitutents (including -CO-) bonded * * to the Cd corresponding to cdtable(i) * * - cdeth(i,2) : Carb number of -O- substitutent bonded to the Cd * * corresponding to cdtable(i) * * * * INPUT/OUTPUT * * - nr : number of reaction channels associated with chem * * - flag(i) : flag that active the channel i * * - tarrhc(i,3) : arrhenius coefficient for channel i * * - pchem(i,2) : the 2 main organic products of reaction channel i * * * ************************************************************************ SUBROUTINE o3add_c7(chem,bond,group,ncd,conjug,cdtable,cdsub, & cdeth,nr,flag,rate,pchem) 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,cdeth(4,2) INTEGER cdtable(4),cdsub(4) ! input/output INTEGER nr, flag(mnr) CHARACTER(LEN=lfo) pchem(mnr,2) REAL rate(mnr) ! internal INTEGER i,j,k,l,nc,nb,nca,p,nrg INTEGER tbond(mca,mca) INTEGER ring(mca),ic1,ic2,ic INTEGER Ci,Cf,rngflg CHARACTER(LEN=lgr) tgroup(mca),pold,pnew CHARACTER(LEN=lfo) tempkg CHARACTER(LEN=lco) tprod(mca) REAL fract(4) REAL rtot ! Initialize ! ----------- nca=0 Ci=0 Cf=0 nc=0 nb=0 tempkg='' ic1=0 ic2=0 ic=0 p=0 DO i=1,4 fract(i)=0 ENDDO DO i=1,mca tgroup(i)=group(i) DO j=1,mca tbond(i,j)=bond(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) ! Linear ethers are not allowed for the moment c IF (rngflg.NE.1) THEN c WRITE(6,*) 'error in O3add_c7' c WRITE(6,*) 'only dihydrofurans are allowed' c WRITE(6,*) 'problem with:' c WRITE(6,*) chem c STOP c ENDIF ! 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, only one criegge can be formed (0% for -O-C.(OO.)*) ! C1H2CdH=Cd(CH3)-O-C1H2: 3.49E-15 nb=cdsub(ic1)+cdsub(ic2) IF (rngflg.EQ.1) THEN rtot=3.49E-15 fract(ic1)=1. fract(ic2)=0 ELSE IF (rngflg.NE.1) THEN rtot=2.0E-16 fract(ic1)=1. fract(ic2)=0 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(ic1)=0.5 ! fract(ic2)=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(ic1)=0.5 ! fract(ic2)=0.5 ! ELSE ! rtot=10E-18/1.18E-17*1.01E-17 ! fract(ic1)=0.65 ! fract(ic2)=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(ic1)=0.70 ! fract(ic2)=0.30 ! ELSE IF ((cdsub(ic1).EQ.2).AND.(cdsub(ic2).EQ.1)) THEN ! fract(ic1)=0.30 ! fract(ic2)=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(ic1)=0.5 ! fract(ic2)=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 ! Break the double bond and change "Cd" to "C" tbond(Cf,Ci)=0 tbond(Ci,Cf)=0 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 ENDIF IF (ic .ne. 0 .and. fract(ic).GT.0.) THEN nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE:rozone' WRITE(6,'(a)') 'too many reactions created for:' WRITE(6,'(a)') chem WRITE(99,*) 'o3add_c7',chem STOP ENDIF flag(nr) = 1 rate(nr) = rtot*fract(ic) ! Change one into carbonyl IF (tgroup(j)(1:3).EQ.'CH2') THEN pold='CH2' pnew='CH2O' ELSE IF (tgroup(j)(1:2).EQ.'CH') THEN pold='CH' pnew='CHO' ELSE IF (tgroup(j)(1:1).EQ.'C') THEN pold='C' pnew='CO' ENDIF tempkg=tgroup(j) CALL swap(tempkg,pold,tgroup(j),pnew) ! Change the other into hot criegee IF (j.EQ.Ci) THEN nc=INDEX(tgroup(Cf),' ') tgroup(Cf)(nc:nc+6)='.(OO.)*' ELSE IF (j.EQ.Cf) THEN nc=INDEX(tgroup(Ci),' ') tgroup(Ci)(nc:nc+6)='.(OO.)*' ENDIF ! Linear Structure IF (rngflg.NE.1) THEN CALL fragm(tbond,tgroup,pchem(nr,1),pchem(nr,2)) CALL stdchm(pchem(nr,1)) CALL stdchm(pchem(nr,2)) ! Case of dihydrofuran ELSE pchem(nr,2)=' ' CALL rebond(tbond,tgroup,pchem(nr,1),nrg) CALL stdchm(pchem(nr,1)) ENDIF ! 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 ! 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 40 CONTINUE ! exit case 7 RETURN END