************************************************************************ * MASTER MECHANISM - ROUTINE NAME : o3add_c1 * * * * * * PURPOSE : * * This subroutine computes the reaction rate for OH addition to a * * >C=C-C=O bond (case 2). The -CO-C=C-C=C-CO- structure is not * * taken into account by this routine (see case 3). * * * * * * 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" * * - tcdcase(i) : carbon number at terminal position in C=C-C=C * * - cdsub(i) : number of -C- substitutents (including -CO-) bonded * * to the Cd corresponding to cdtable(i) * * - cdcarbo(i,2) : Carb number of -CO- substitutent 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 * * - tarrhc(i,3) : arrhenius coefficient for channel i * * - pchem(i,2) : the 2 main organic products of reaction channel i * * * ************************************************************************* SUBROUTINE o3add_c2(chem,bond,group, & ncd,conjug,cdtable,cdsub,cdcarbo, & nr,flag,rate,pchem, parent_group) 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) INTEGER cdcarbo(4,2) INTEGER parent_group(mnr) * input/output INTEGER nr, flag(mnr) CHARACTER(LEN=lfo) pchem(mnr,2) REAL rate(mnr) * internal INTEGER i,j,k,l,j1,nc INTEGER Ci,Cf,Cj INTEGER tbond(mca,mca) CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempkg REAL kacr,kadd,mult,fract(2) INTEGER dicarb INTEGER nbcarb,nbcarbi,nbcarbf INTEGER posf, posi INTEGER nbCHO1,nbCHO2,nbCO1,nbCO2 INTEGER ng,rngflg,ring(mca),nring CHARACTER(LEN=lsb) :: progname='*o3add_c2* ' CHARACTER(LEN=ler) :: mesg * write info for finding bugs IF (wtflag.NE.0) WRITE(*,*) progname * Initialize * ----------- ng=0 DO i=1,mca tgroup(i)=group(i) DO j=1,mca tbond(i,j)=bond(i,j) ENDDO IF (tgroup(i).NE.' ') ng=ng+1 ENDDO kacr= 2.9E-19 kadd=0 dicarb=0 mult=1. nbcarb=0 nbcarbi=0 nbcarbf=0 posf=0 posi=0 ********************************************************************* * One double bond structures with carbonyl * ********************************************************************* * In cdtable, 1-2 and 3-4 indexes of cdtable are double bonded. Note * that only one single bond must be "active" in this subroutine and * either cdtable(1-2) or cdtable(3-4) must be 0. * find Ci and Cf such that Cdf=Cdi-C=O and count total number of * carbonyls bonded to the double bond DO i=1,3,2 IF (cdtable(i).ne.0) THEN IF (cdcarbo(i,1).ne.0) THEN Ci=cdtable(i) Cf=cdtable(i+1) posi=i posf=i+1 DO j=1,2 IF (cdcarbo(posi,j).ne.0) nbcarbi=nbcarbi+1 IF (cdcarbo(posf,j).ne.0) nbcarbf=nbcarbf+1 ENDDO GOTO 63 ELSE IF (cdcarbo(i+1,1).ne.0) THEN Ci=cdtable(i+1) Cf=cdtable(i) posi=i+1 posf=i DO j=1,2 IF (cdcarbo(posi,j).ne.0) nbcarbi=nbcarbi+1 IF (cdcarbo(posf,j).ne.0) nbcarbf=nbcarbf+1 ENDDO GOTO 63 ENDIF ENDIF ENDDO 63 CONTINUE * check that a carbonyl was found IF (Ci.eq.0) THEN WRITE(6,*) '--error in o3add_c2 routine' WRITE(6,*) 'no carbonyl bonded to Ci' WRITE(99,*) 'o3add_c2',chem !STOP ENDIF * For -C=O-Cd(CO)=Cd(CO)-CO-, no reaction with O3 nbcarb=nbcarbi+nbcarbf IF (nbcarb.GT.3) THEN RETURN ENDIF * search C(=O)-Cd=Cd-C=O structures, in this case dicarb = 1 dicarb=0 IF (nbcarbi.gt.0) THEN IF (nbcarbf.gt.0) dicarb=1 ENDIF * ------------------------------------ * carbonyl only at one side (-C=C-CO-) * ------------------------------------ * * For aldehyde k=(k acrolein) * mult with mult depending on group * on the double bond. * For ketone k=(k acrolein)*18.6*mult * alkyl in alpha position : mult=mult*3.9 * alkyl in beta position : mult=mult*6 * two carbonyl on the same Cd, assume only one carbonyl * If the double bond is attached to -C=C-CO, the influence is * assumed to be a factor of 0.03 (estimated with the 1-6 dicarbonyl * values). * * In other words : * At the carbon bearing the carbonyl group : * If the substituents contain a least 1 -CHO group, then weighting * factor is 1. If one of the substituents is -CHO and the other -CO-, * then weighting factor is 1. If 2 -CO- then 18.6*3.9. Other * substituents have weight 3.9 * At the other side of the C=C(CO) bond : * add a factor 3 for each substituent (should not be not carbonyl here) IF (dicarb.eq.0) THEN mult=1. Cj=cdcarbo(posi,1) IF (group(Cj).eq.'CHO') THEN IF (cdsub(posi).eq.2) THEN IF (cdcarbo(posi,2).eq.0) THEN mult=mult*3.9 ELSE mult=1. ENDIF ELSE mult=1 ENDIF ELSE IF (group(Cj)(1:2).eq.'CO') THEN IF (cdsub(posi).eq.2) THEN IF (cdcarbo(posi,2).eq.0) THEN mult=mult*3.9*18.6 ELSE IF (group(cdcarbo(posi,2))(1:2).eq.'CO') THEN mult=mult*3.9*18.6 ELSE mult=1. ENDIF ELSE mult=18.6 ENDIF ENDIF IF (cdsub(posf).eq.1) THEN mult=mult*6.0 ELSE IF(cdsub(posf).eq.2) THEN mult=mult*6.0*6.0 ENDIF kadd=kacr kadd=kadd*mult * find the branching ratio : frac(1)=carbonyl at Cf and criegge at Ci * frac(2)=carbonyl at Ci and criegge at Cf fract(1)=0.05 fract(2)=0.95 IF (cdsub(posi).eq.2) THEN IF (cdcarbo(posi,2).eq.0) THEN fract(1)=0.10 fract(2)=0.90 ELSE fract(1)=0. fract(2)=1. ENDIF ENDIF * ------------------------------------ * carbonyl at both sides (-CO-C=C-CO-) * ------------------------------------ * * use the values of butenedial,4-oxo-pentenal or 3-hexene-2,5-dione * even if there are three carbonyls ELSE kadd=0 nbCHO1=0 nbCHO2=0 nbCO1=0 nbCO2=0 DO i=1,2 IF (cdcarbo(posi,i).ne.0) THEN IF (group(cdcarbo(posi,i)).eq.'CHO') nbCHO1=nbCHO1+1 IF (group(cdcarbo(posi,i))(1:2).eq.'CO') nbCO1=nbCO1+1 ENDIF IF (cdcarbo(posf,i).ne.0) THEN IF (group(cdcarbo(posf,i)).eq.'CHO') nbCHO2=nbCHO2+1 IF (group(cdcarbo(posf,i))(1:2).eq.'CO') nbCO2=nbCO2+1 ENDIF ENDDO IF ((nbCO1.ne.0).and.(nbCO2.ne.0)) kadd=3.6E-18 IF ((nbCHO1.ne.0).and.(nbCHO2.ne.0)) kadd=1.6E-18 IF (kadd.eq.0) kadd=4.8E-18 * find the branching ratio : frac(1)=carbonyl at Cf and criegge at Ci * frac(2)=carbonyl at Ci and criegge at Cf IF (nbcarb.eq.2) THEN IF (cdsub(posi).eq.cdsub(posf)) THEN fract(1)=0.5 fract(2)=0.5 ELSE IF (cdsub(posi).gt.cdsub(posf)) THEN fract(1)=0.7 fract(2)=0.3 ELSE fract(1)=0.3 fract(2)=0.7 ENDIF ELSE IF (nbcarb.eq.3) THEN IF (nbcarbi.LT.2) THEN fract(1)=1. fract(2)=0. ELSE IF (nbcarbf.LT.2) THEN fract(1)=0. fract(2)=1. ENDIF ENDIF kadd=kadd*mult ENDIF * ------------------ * do the reaction * ------------------ DO i=1,2 nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE:O3add_c2' WRITE(6,'(a)') 'too many reactions created for:' WRITE(6,'(a)') chem WRITE(99,*) 'o3add_c2',chem !STOP ENDIF flag(nr) = 1 rate(nr) = kadd*fract(i) * check if the bond that will be broken belong to a cycle CALL findring(Cf,Ci,ng,tbond,rngflg,ring) * break the C=C bond 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) * change cdtable(i) carbon to carbonyl IF (tgroup(Cf)(1:3).EQ.'CH2') THEN pold = 'CH2' pnew = 'CH2O' ELSE IF (tgroup(Cf)(1:2).EQ.'CH') THEN pold = 'CH' pnew = 'CHO' ELSE IF (tgroup(Cf)(1:1).EQ.'C') THEN pold = 'C' pnew = 'CO' ENDIF CALL swap(tgroup(Cf),pold,tempkg,pnew) tgroup(Cf) = tempkg * change the other carbon to hot criegee: nc = INDEX(tgroup(Ci),' ') tgroup(Ci)(nc:nc+6) = '.(OO.)*' ! save id of parent group in parent alkene ! used for stabilisation yield parent_group(nr) = Ci * fragment the species only if the reaction leads to 2 products IF(rngflg.EQ.1) THEN CALL rebond(tbond,tgroup,tempkg,nring) pchem(nr,1)=tempkg pchem(nr,2)=' ' ELSE CALL fragm(tbond,tgroup,pchem(nr,1),pchem(nr,2)) ENDIF * rewrite in standard format: CALL stdchm(pchem(nr,1)) CALL stdchm(pchem(nr,2)) * reset groups and bonds: DO j=1,mca tgroup(j) = group(j) DO k=1,mca tbond(j,k) = bond(j,k) ENDDO ENDDO * change Ci to Cf and Cf to Ci k=Ci Ci=Cf Cf=k ENDDO END