************************************************************************ * MASTER MECHANISM - ROUTINE NAME : o3add_c5 * * * * * * PURPOSE : * * This subroutine computes the reaction rate for O3 addition to * * >C=C-C=C-CO- structures (case 5). * * Adds O3 to carbonyl end ONLY - GROSS ASSUMPTION * * Uses rate calculation from o3add_c2 * * * * 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 (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 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_c5(chem,bond,group,ncd,conjug,cdtable,cdsub, & cdcarbo,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 INTEGER cdtable(4),cdsub(4) INTEGER cdcarbo(4,2) * input/output INTEGER nr, flag(mnr) CHARACTER(LEN=lfo) pchem(mnr,2) REAL rate(mnr) * internal INTEGER i,j,k,l,j1,nc,nb,ic1,ic2 INTEGER tbond(mca,mca) INTEGER Ci,Cf,Cj CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempkg CHARACTER(LEN=lco) tprod(mca) REAL fract(4) REAL rtot INTEGER nbcarb,nbcarbi,nbcarbf,posf,posi,nco INTEGER nring, ndis INTEGER nca,m,n, pos1, pos2 INTEGER rngflg INTEGER ring(mca) INTEGER last,ncx CHARACTER(LEN=lsb) :: progname='*o3add_c5* ' CHARACTER(LEN=ler) :: mesg * write info for finding bugs IF (wtflag.NE.0) WRITE(*,*) progname * Initialize * ----------- tgroup(:)=group(:) tbond(:,:)=bond(:,:) nbcarb=0 nbcarbi=0 nbcarbf=0 nca=0 last=0 DO i=1,mca IF (group(i)(1:1).NE.' ') THEN nca=nca+1 last=i ENDIF ENDDO ncx = 0 DO i=1,last DO j=i+1,last IF(bond(i,j).GT.0) ncx = ncx + 1 ENDDO ENDDO nring=ncx-nca+1 ********************************************************************* * 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_c5 routine' WRITE(6,*) 'no carbonyl found' WRITE(99,*) 'o3add_c5',chem !STOP ENDIF * For -C=O-Cd(CO)=Cd(CO)-CO-, no reaction with O3 nbcarb=nbcarbi+nbcarbf IF (nbcarb.GT.3) THEN WRITE(6,*) '--error in o3add_c5 routine' WRITE(6,*) ' carbonyl side saturated:' WRITE(6,*) ' need to react other double bond for' WRITE(6,'(a)') chem WRITE(99,*) 'o3add_c5',chem !STOP ENDIF * check that there is only one carbonyl nco=0 DO i=1,4 DO j=1,2 IF (cdcarbo(i,j).ne.0) nco=nco+1 ENDDO ENDDO IF (nco.gt.1) THEN ! WRITE(6,'(a)') '--error--' ! WRITE(6,'(a)')'from MASTER MECHANISM ROUTINE : o3add_c5' ! WRITE(6,'(a)') 'case 5 encountered with dicarbonyl:' ! WRITE(6,'(a)') chem WRITE(99,*) 'o3add_c5',chem ! 2016 : We assume that the double carbonyl desactivate the C=C compared ! to the OH reaction RETURN ! STOP ENDIF * ================================================================= * -------------------------------------- * set rate constant and branching ratio, as though molecule were >C=C-R * adapted from o3add_c1, using c1 rates * -------------------------------------- * Rate constant are assigned for the C=C bond, not for each Cd. * Evaluation is made using group rate constants provided in the SAPRC99 * mechanism. Values are mean values based on the rate constants provided * in Atkinson, 1997, J. Phys. Chem. Ref. Data. * CH2=CH2 : 1.68E-18 * C-CH=CH2 : 1.01E-17 * C-C(C)=CH2 : 1.18E-17 * C-CH=CH-C : 1.15E-16 * C-C(C)=CH-C : 3.48E-16 * C-C(C)=C(C)-C : 1.13E-15 * Branching ratio is set assuming 50 % for both channels for a symmetrical * C=C bond (in the sense of the group defined above). For a non-symmetrical * C=C bond, the following is used (which is almost identical to yields * provided in the SAPRC99 chemical scheme): * C-CH=CH2 : 50 % for each side (see data in Atkinson, 1997) * C-C(C)=CH2 : 65 % (HCHO + >C.(OO.)) , 35 % (>C=O + CH2.(OO.)) * C-C(C)=CH-C : 30 % (>C=O + R-CH.(OO.)) , 70 % (R-CHO + >C.(OO.)) * Loop over the 2 possible double bonds. In cdtable and other related * tables, table elements 1-2 and 3-4 are double bonded. Only do reaction * for double bond WITHOUT carbonyl DO 40 ic1=1,3,2 IF (cdtable(ic1).ne.0) THEN ic2=ic1+1 IF ((cdcarbo(ic1,1).eq.0).AND.(cdcarbo(ic2,1).eq.0)) THEN * assign the rate constant and branching ratio * -------------------------------------------- nb=cdsub(ic1)+cdsub(ic2) * -CH=CH2 IF (nb.eq.1) THEN rtot=1.01E-17 fract(ic1)=0.5 fract(ic2)=0.5 * -CH=CH- or >C=CH2 ELSE IF (nb.eq.2) THEN IF (cdsub(ic1).eq.1) THEN rtot=1.15E-16 fract(ic1)=0.5 fract(ic2)=0.5 ELSE rtot=1.18E-17 IF ( (cdsub(ic1).eq.0).AND.(cdsub(ic2).eq.2) ) THEN fract(ic1)=0.65 fract(ic2)=0.35 ELSE IF ( (cdsub(ic1).eq.2).AND.(cdsub(ic2).eq.0) ) THEN fract(ic1)=0.35 fract(ic2)=0.65 ENDIF ENDIF * >CH=CH- ELSE IF (nb.eq.3) THEN rtot=3.48E-16 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_c5, no ratio found ' WRITE(99,*) 'o3add_c5',chem !STOP ENDIF * >CH=CH< ELSE IF (nb.eq.4) THEN rtot=1.13E-15 fract(ic1)=0.5 fract(ic2)=0.5 ELSE WRITE(6,*) '-error1-- in O3add_c5, no rate constant found' WRITE(99,*) 'o3add_c5',chem !STOP ENDIF ELSE GOTO 40 ENDIF ENDIF * ------------------ * do the reaction * ------------------ DO i=ic1,ic2 IF (fract(i).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_c5',chem !STOP ENDIF flag(nr) = 1 rate(nr) = rtot*fract(i) * check if bond that will be brocken belong to a cycle. pos1=cdtable(ic1) pos2=cdtable(ic2) CALL findring(pos1,pos2,nca,tbond,rngflg,ring) * break the C=C bond and change "Cd" to "C" tbond(cdtable(ic1),cdtable(ic2)) = 0 tbond(cdtable(ic2),cdtable(ic1)) = 0 pold = 'Cd' pnew = 'C' tempkg=group(cdtable(ic1)) CALL swap(tempkg,pold,tgroup(cdtable(ic1)),pnew) tempkg=group(cdtable(ic2)) CALL swap(tempkg,pold,tgroup(cdtable(ic2)),pnew) * change cdtable(i) carbon to carbonyl IF (tgroup(cdtable(i))(1:3).EQ.'CH2') THEN pold = 'CH2' pnew = 'CH2O' ELSE IF (tgroup(cdtable(i))(1:2).EQ.'CH') THEN pold = 'CH' pnew = 'CHO' ELSE IF (tgroup(cdtable(i))(1:1).EQ.'C') THEN pold = 'C' pnew = 'CO' ENDIF CALL swap(tgroup(cdtable(i)),pold,tempkg,pnew) tgroup(cdtable(i)) = tempkg * change the other carbon to hot criegee: IF (i.eq.ic1) THEN j1=ic2 ELSE j1=ic1 ENDIF nc = INDEX(tgroup(cdtable(j1)),' ') tgroup(cdtable(j1))(nc:nc+6) = '.(OO.)*' * Check the number of distinct molecule (could be 1 because of * ring structure, eg terpenes). If 2 then fragments the species into 2 parts. c CALL chk_nmol(tbond,tgroup,ndis) IF (rngflg.eq.1) THEN CALL rejoin(nca,pos1,pos2,m,n,tbond,tgroup) CALL rebond(tbond,tgroup,tempkg,nring) pchem(nr,1)=tempkg pchem(nr,2)=' ' CALL stdchm(pchem(nr,1)) ELSE IF (rngflg.eq.0) THEN * fragments the species into 2 parts CALL fragm(tbond,tgroup,pchem(nr,1),pchem(nr,2)) * rewrite in standard format: CALL stdchm(pchem(nr,1)) CALL stdchm(pchem(nr,2)) ELSE WRITE(6,*) '--error--, number of distinct molecule is' WRITE(6,*) 'not equal to 1 or 2 in o3add_c5 (see rngflg)' STOP ENDIF * reset groups and bonds: DO j=1,mca tgroup(j) = group(j) DO k=1,mca tbond(j,k) = bond(j,k) ENDDO ENDDO ENDIF ENDDO 40 CONTINUE * exit case 5 RETURN END