************************************************************************ * MASTER MECHANISM - ROUTINE NAME : no3add_c5 * * * * * * PURPOSE : * * This subroutine computes the reaction rates for NO3 addition to * * >C=C-C=C-CO- structure (case 5). * * * * We assume NO3 adds exclusively to the end furthest from the * * carbonyl, producing a beta- or delta-radical, depending on number * * of substituents including -CHO / -CRO (as in routine no3add_c1) * * Rates set at 0.5 x the rate for a non-carbonyl conjugated alkene. * * * * Justification: rates for addition to >C=C-CO- are around an order * * of magnitude lower than for >C=C< (no3add_c1 vs no3add_c2), and * * presence of a carbonyl reduces the rate for that bond by a factor * * of 0.073 (no3add_c3) * * * * 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- substitutents (including -CO-) bonded * * to the Cd corresponding to cdtable(i) * * * * INPUT/OUTPUT * * - nr : number of reaction channels associated with chem * * - flag(i) : flag for active 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_c5(chem,bond,group,ncd,conjug,cdtable,cdsub, & cdcarbo, & nr,flag,rno3,pchem,coprod,flag_del,pchem_del, & coprod_del,sc_del) IMPLICIT NONE INCLUDE 'general.h' * input: CHARACTER(LEN=lfo) chem INTEGER bond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER ncd, conjug INTEGER cdtable(4),cdsub(4) INTEGER cdcarbo(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,j1,nc,nb,ic1,ic2,nb1,nb2 INTEGER tbond(mca,mca),nring CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempgr CHARACTER(LEN=lco) tprod(mca) REAL fract(4) REAL rtot REAL beta,delta INTEGER ialpha, ibeta, igamma, idelta 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_c5' CHARACTER(LEN=ler) :: mesg * ----------- * Initialize * ----------- tgroup=group tbond=bond ialpha=0 * ================================================================= * conjugated Cds (>C=C-C=C<) structures (note from no3add_c1) * ================================================================= * * alkyl group at terminal position (i.e. alpha and delta) seems to have * a greater impact on rate constant than alkyl group at internal * position (i.e beta and gamma). Therefore, rate constant is asigned * by considering first the alkyl group at terminal position. A correction * is then made to account for the contribution of the internal alkyl group. * Rate constants are assigned as follows : * CH2=CH-CH=CH2 : 1.00E-13 * C-CH=CH-CH=CH2 : 1.50E-12 (from CH3-CH=CH-CH=CH2) * C-CH=CH-CH=CH-C : 1.60E-11 (from CH3-CH=CH-CH=CH-CH3) * and then multiply by 6.8 if there is 1 internal alkyl group (ratio * isoprene / 1,3 butadiene) and 21 if there are 2 internal alkyl groups * (ratio 2,3 dimethyl / 1,3 butadiene and butadiene) * ALL THIS IS OF COURSE A VERY CRUDE ESTIMATE. (more work should be done in * the future to better estimate these rate constants) * * For branching ratio : NO3 is assumed to add at the less substitued terminal * position. If the 2 terminal positions are equivalent, then the dominant * position is assumed to be the one yielding the highest substitued radical * -------------------------------------- * set rate constant and branching ratio * -------------------------------------- * set the rate constant - contribution of external alkyl group nb=cdsub(1)+cdsub(4) IF (nb.eq.0) THEN rtot=1.00E-13 ELSE IF (nb.eq.1) THEN rtot=1.50E-12 ELSE IF (nb.gt.1) THEN rtot=1.60E-11 ENDIF rtot = rtot * 0.5 * contribution of internal alkyl group (nb=3 means 1 internal alkyl group) nb=cdsub(2)+cdsub(3) IF (nb.eq.3) rtot=rtot*6.8 IF (nb.gt.3) rtot=rtot*21. * ---------------- * 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 : no3rad ' WRITE(6,'(a)') 'case 5 encountered but Carbonyl not found for' WRITE(6,'(a)') chem WRITE(99,*) 'no3add_c5',chem !STOP ENDIF * define branching ratio for NO3 addition as 100% at ialpha DO i=1,4 fract(i)=0. ENDDO fract(ialpha)=1. * ---------------- * do the reaction * ---------------- * NO3 adds at terminal position (ialpha position), radical dot is at * beta position (ibeta) or delta position (idelta). * !! reduce cdsub(ibeta) by 1 to avoid considering conjugation bond !! IF (ialpha.eq.1) THEN ibeta=2 igamma=3 idelta=4 ELSE ibeta=3 igamma=2 idelta=1 ENDIF IF (fract(ialpha).ne.0.) THEN IF (cdsub(ibeta)-1.eq.cdsub(idelta)) THEN beta=0.5 delta=0.5 ELSE IF (cdsub(ibeta)-1.gt.cdsub(idelta)) THEN beta=1. delta=0. ELSE beta=0. delta=1. ENDIF * ric : do the beta addition, delocalisation is now done in radchk beta=1. delta=0. ! ric : estimate rate constant CALL raddno3(tbond,tgroup,cdtable(ialpha),cdtable(ibeta),arrhc) * BETA ADDITION * ------------- IF (beta.ne.0.) THEN nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE:no3rad' WRITE(6,'(a)') 'too many reactions created for:' WRITE(6,'(a)') chem WRITE(99,*) 'no3add_c5',chem !STOP ENDIF flag(nr) = 1 c rno3(nr) = rtot*fract(ialpha)*beta rno3(nr) = arrhc(1) * convert to single carbon bonds: tbond(cdtable(ialpha),cdtable(ibeta)) = 1 tbond(cdtable(ibeta),cdtable(ialpha)) = 1 pold = 'Cd' pnew = 'C' tempgr=group(cdtable(ialpha)) CALL swap(tempgr,pold,tgroup(cdtable(ialpha)),pnew) tempgr=group(cdtable(ibeta)) CALL swap(tempgr,pold,tgroup(cdtable(ibeta)),pnew) * add (ONO2) to cdtable(i) carbon, nc = INDEX(tgroup(cdtable(ialpha)),' ') tgroup(cdtable(ialpha))(nc:nc+5) = '(ONO2)' * add radical dot to the other carbon: nc = INDEX(tgroup(cdtable(ibeta)),' ') tgroup(cdtable(ibeta))(nc:nc) = '.' * rebuild, check, and rename: CALL rebond(tbond,tgroup,tempgr,nring) c CALL radchk(tempgr,pchem(nr),tprod) CALL radchk(tempgr,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) sc_del(nr,1) = sc(1) IF (nip.EQ.2) THEN flag_del(nr) = 1 pchem_del(nr) = rdckprod(2) sc_del(nr,2) = sc(2) CALL stdchm(pchem_del(nr)) coprod_del(nr,:) = rdcktprod(2,:) ENDIF CALL stdchm(pchem(nr)) coprod(nr,:) = rdcktprod(1,:) * reset groups and bonds: tgroup(:) = group(:) tbond(:,:) = bond(:,:) ENDIF * DELTA ADDITION * --------------- c IF (delta.ne.0.) THEN IF ((delta.ne.0.).AND.(delta.NE.0.5)) 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(ialpha)*delta * convert to single carbon bonds: tbond(cdtable(ialpha),cdtable(ibeta)) = 1 tbond(cdtable(ibeta),cdtable(ialpha)) = 1 tbond(cdtable(igamma),cdtable(idelta)) = 1 tbond(cdtable(idelta),cdtable(igamma)) = 1 pold = 'Cd' pnew = 'C' tempgr=group(cdtable(ialpha)) CALL swap(tempgr,pold,tgroup(cdtable(ialpha)),pnew) tempgr=group(cdtable(idelta)) CALL swap(tempgr,pold,tgroup(cdtable(idelta)),pnew) * add (ONO2) to cdtable(i) carbon, nc = INDEX(tgroup(cdtable(ialpha)),' ') tgroup(cdtable(ialpha))(nc:nc+5) = '(ONO2)' * add radical dot to the other carbon: nc = INDEX(tgroup(cdtable(idelta)),' ') tgroup(cdtable(idelta))(nc:nc) = '.' * add the double bond between beta and gamma position tbond(cdtable(ibeta),cdtable(igamma)) = 2 tbond(cdtable(igamma),cdtable(ibeta)) = 2 * rebuild, check, and rename: CALL rebond(tbond,tgroup,tempgr,nring) c CALL radchk(tempgr,pchem(nr),tprod) CALL radchk(tempgr,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) sc_del(nr,1) = sc(1) IF (nip.EQ.2) THEN flag_del(nr) = 1 pchem_del(nr) = rdckprod(2) sc_del(nr,2) = sc(2) CALL stdchm(pchem_del(nr)) coprod_del(nr,:) = rdcktprod(2,:) ENDIF CALL stdchm(pchem(nr)) coprod(nr,:) = rdcktprod(1,:) ENDIF ENDIF RETURN END