************************************************************************ * MASTER MECHANISM - ROUTINE NAME : no3add_c7 * * * * * * PURPOSE : * * This subroutine computes the reaction rates for NO3 addition to * * >C=C< bond (case 1). Species having a C=O group conjugated with * * the C=C are not taken into account here * * * * Part I performs the reaction for simple >C=C< bond ; Part II for * * the conjugated >C=C-C=C< bonds. The method used for each case is * * described in the body of the program. * * * * The reaction products are returned in pchem for the main organic * * product and in coprod for coproducts of the reation. * * * * 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" * * - cdsub(i) : number of -C- substitutant (including -CO-) bonded * * to the Cd corresponding to cdtable(i) * * * * INPUT/OUTPUT * * - nr : number of reaction channel associated with chem * * - flag(i) : flag that active the channel i * * - rno3(i,3) : reaction rate (298 K) for channel i * * - pchem(i) : the main organic product of reaction channel i. * * - coprod(i,j) : coproducts of reaction channel i * * * ************************************************************************ SUBROUTINE no3add_c7(chem,bond,group,ncd,conjug,cdtable,cdsub, & cdeth,nr,flag,rno3,pchem,coprod) 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),cdsub(4),cdeth(4,2) * input/output INTEGER nr, flag(mnr) CHARACTER(LEN=lfo) pchem(mnr) REAL rno3(mnr) CHARACTER(LEN=lco) coprod(mnr,mca) * internal INTEGER i,j,k,l,nc,nb,ic1,ic2,Cf,Ci INTEGER tbond(mca,mca),nrg,nca,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) REAL 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) REAL arrhc(3) CHARACTER(LEN=lsb) :: progname='no3add_c7' CHARACTER(LEN=ler) :: mesg IF(wtflag.NE.0) PRINT*,"*no3add_c7*" !------------- ! Initialize !------------- nca=0 Ci=0 Cf=0 nc=0 nb=0 tempkg=' ' ic1=0 ic2=0 nip=0 fract=0 tgroup=group tprod=' ' sc = 0 rdckprod=' ' tbond=bond rdcktprod=' ' 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 ! 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: 1.68E-10 CALL findring(ic1,ic2,nca,bond,rngflg,ring) IF (rngflg.GT.0) THEN ! JMLT ! inhibit NO3 addition to cyclic ethers ! ! PRINT*,'NO3,c7' !STOP fract(ic1)=0.5 fract(ic2)=0.5 c rtot=1.68E-10 ELSE fract(ic1)=0.5 fract(ic2)=0.5 c rtot=1.47E-12 ENDIF CALL raddno3(tbond,tgroup,cdtable(ic1),cdtable(ic2),arrhc) rtot = arrhc(1) ! -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 mesg = 'too many reactions created for:' CALL errexit(progname,mesg,chem) ENDIF flag(nr) = 1 rno3(nr) = rtot*fract(ic) ! Add OH to one carbon nc=INDEX(tgroup(j),' ') tgroup(j)(nc:nc+5)='(ONO2)' ! 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 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 no3_addc7.f' coprod(nr,:) = rdcktprod(1,:) ! Reset groups and bonds: tgroup(:) = group(:) tbond(:,:) = bond(:,:) ENDIF ENDDO ENDIF 40 CONTINUE ! exit case 7 RETURN END