************************************************************************ * MASTER MECHANISM - ROUTINE NAME : no3add_c3 * * * * * * PURPOSE : * * This subroutine computes the reaction rate for NO3 addition to * * -CO-C=C-C=C-CO- structure (case 3) only. * * * * * * 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) * * - cdcarbo(i) : number of -CO- substitutents 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_c3(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,nc INTEGER Ci,Cf INTEGER tbond(mca,mca),nring CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempgr CHARACTER(LEN=lco) tprod(mca) REAL kstruct REAL fract(4) REAL rat(2) REAL fac INTEGER nbcarb,nbcarbi,nbcarbf INTEGER posf, posi 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_c3' CHARACTER(LEN=ler) :: mesg * ----------- * Initialize * ----------- tgroup=group tbond=bond * In cdtable, 1-2 and 3-4 indexes of cdtable are double bonded. * find Ci and Cf such that Cdf=Cdi-C=O and count total number of * carbonyls bonded to the double bond. Each double bond is treated as * if it is not conjugated. A weighting factor is used to take into * account the effect of the reactivity of the "second" -C=C-CO- * on the "first" -C=C-CO- bond DO i=1,4,3 nbcarbi=0 nbcarbf=0 IF (i.eq.1) THEN IF (cdcarbo(1,1).NE.0) THEN Ci=cdtable(1) Cf=cdtable(2) posi=1 posf=2 ELSE IF (cdcarbo(2,1).NE.0) THEN Ci=cdtable(2) Cf=cdtable(1) posi=2 posf=1 ENDIF ELSE IF (i.eq.4) THEN IF (cdcarbo(4,1).NE.0) THEN Ci=cdtable(4) Cf=cdtable(3) posi=4 posf=3 ELSE IF (cdcarbo(3,1).NE.0) THEN Ci=cdtable(3) Cf=cdtable(4) posi=3 posf=4 ENDIF ENDIF DO j=1,2 IF (cdcarbo(posi,j).ne.0) nbcarbi=nbcarbi+1 IF (cdcarbo(posf,j).ne.0) nbcarbf=nbcarbf+1 ENDDO * set the rate constant * -CH=CR-CO- or -CH=CH-CO- structures IF (group(Cf)(1:3).eq.'CdH') THEN IF (group(Ci)(1:3).eq.'CdH') THEN kstruct = 2.11E-15 rat(1)=0.5 rat(2)=0.5 ELSE kstruct= 7.6E-14 rat(1)=0. rat(2)=1. ENDIF * >C=CR-CO- or >C=CH-CO- structures ELSE IF (group(Cf)(1:2).eq.'Cd') THEN IF (group(Ci)(1:3).eq.'CdH') THEN kstruct = 1.07E-13 rat(1)=0. rat(2)=1. ELSE kstruct = 2.3E-13 rat(1)=0.5 rat(2)=0.5 ENDIF ELSE mesg = '-CO-C=C-C=C-CO- structure expected for : ' CALL errexit(progname,mesg,chem) ENDIF * correct kstruct as a function of the functional group on Ci and Cf * and multiply by 0.073 due to -C=C-CO- fac=1. fac=fac*0.073 DO k=1,nbcarbf fac=fac*0.01 ENDDO IF (nbcarbi.eq.2) fac=fac*0.01 ! estimate rate constant CALL raddno3(tbond,tgroup,Ci,Cf,arrhc) * make the two NO3 additions to the >C=C<. * Ci and Cf are swapped between j=1 and j=2. DO j=1,2 nr = nr + 1 IF (nr.GT.mnr) THEN mesg = 'too many reactions created for species' CALL errexit(progname,mesg,chem) ENDIF flag(nr) = 1 * assign rate constant for ONO2 addition in Ci position c rno3(nr)=kstruct*fac*rat(j) rno3(nr) = arrhc(1)*rat(j) * convert Cf to single bond carbon tbond(Cf,Ci)=1 tbond(Ci,Cf)=1 pold = 'Cd' pnew = 'C' CALL swap(group(Cf),pold,tgroup(Cf),pnew) * convert Ci to single bond carbon pold = 'Cd' pnew = 'C' CALL swap(group(Ci),pold,tgroup(Ci),pnew) * add NO3 to Ci carbon and add radical dot to Cf nc = INDEX(tgroup(Ci),' ') tgroup(Ci)(nc:nc+5) = '(ONO2)' nc = INDEX(tgroup(Cf),' ') tgroup(Cf)(nc:nc) = '.' * rebuild, check, and find coproducts: CALL rebond(tbond,tgroup,tempgr,nring) c CALL radchk(tempgr,pchem(nr),tprod) CALL radchk(tempgr,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) IF (nip.NE.1) THEN flag_del(nr) = 1 sc_del(nr,1) = sc(1) sc_del(nr,2) = sc(2) pchem_del(nr) = rdckprod(2) CALL stdchm(pchem_del(nr)) coprod_del(nr,:) = rdcktprod(2,:) ENDIF coprod(nr,:) = rdcktprod(1,:) * rename CALL stdchm(pchem(nr)) * reset: tgroup(Ci) = group(Ci) tgroup(Cf) = group(Cf) tbond(Ci,Cf) = bond(Ci,Cf) tbond(Cf,Ci) = bond(Cf,Ci) * Convert Ci to Cf and Cf to Ci to form the other radical k=Ci Ci=Cf Cf=k ENDDO ENDDO END