************************************************************************ * MASTER MECHANISM - ROUTINE NAME : hoadd_c2 * * * * * * PURPOSE : * * This subroutine computes the reaction rate for OH addition on * * >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). * * * * The method used is the SAR of Kwok and Atkinson, Atmos. Environ., * * 1685-1695, 1995. * * * * Note : addition of OH is expected to occur mainly at the beta * * position (with respect to the -CO group), i.e leading to the * * >C(OH)-CR(.)-CO- structure. A yield of 80 % is set for this pathway* * * * 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 * * * * INPUT/OUTPUT * * - nr : number of reaction channel associated with chem * * - flag(i) : flag that active the channel i * * - tarrhc(i,3) : arrhenius coefficient for channel i * * - pchem(i) : main organic product of reaction channel i * * - coprod(i,j) : coproducts j of reaction channel i * * * ************************************************************************* SUBROUTINE hoadd_c2(chem,bond,group, & ncd,conjug,cdtable,cdsub,cdcarbo, & nr,flag,tarrhc,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) INTEGER cdcarbo(4,2) * input/output INTEGER nr, flag(mnr) REAL tarrhc(mnr,3) CHARACTER(LEN=lfo) pchem(mnr) CHARACTER(LEN=lco) coprod(mnr,mca) * internal INTEGER i,j,k,l,ci,cf,nbcarbi,nbcarbf,nc,nring INTEGER posi,posf INTEGER tbond(mca,mca) CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempkc CHARACTER(LEN=lco) tprod(mca) REAL kstruct, fac CHARACTER(LEN=lfo) rdckprod(mca) CHARACTER(LEN=lco) rdcktprod(mca,mca) INTEGER nip REAL sc(mca) CHARACTER(LEN=lsb) :: progname='*hoadd_c2* ' CHARACTER(LEN=ler) :: mesg * write info for finding bugs IF (wtflag.NE.0) WRITE(*,*) progname * initialize * ----------- DO i=1,mca tgroup(i)=group(i) DO j=1,mca tbond(i,j)=bond(i,j) ENDDO ENDDO ci=0 cf=0 posi = 0 posf = 0 ********************************************************************* * One double bond structures with carbonyl * ********************************************************************* * Note: 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 as Cdf=Cdi-C=O and count total number of * carbonyls bonded to the double bond DO i=1,3,2 nbcarbi=0 nbcarbf=0 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 * set the rate constant for the >C=C< structure * ---------------------------------------------- * k struct for >C=CR-CO- or >C=CH-CO- structures IF (cdsub(posf).eq.2) THEN IF (cdsub(posi).eq.1) THEN kstruct = 86.9E-12 ELSE kstruct = 110E-12 ENDIF * kstruct for -CH=CR-CO- or -CH=CH-CO- structures ELSE IF (cdsub(posf).eq.1) THEN IF (cdsub(posi).eq.1) THEN kstruct = 60.2E-12 ELSE kstruct=86.9E-12 ENDIF * kstruct for CH2=CR-CO- or CH2=CH-CO- structures ELSE IF (cdsub(posf).eq.0) THEN IF (cdsub(posi).eq.1) THEN kstruct = 26.3E-12 ELSE kstruct = 51.4E-12 ENDIF ENDIF * modify rate constant as a function of the substituent * ----------------------------------------------------- fac=1. DO l=1,mca * find group on Cf ('CO' and 'CO(O' do not have the same weight) IF ((bond(Cf,l).eq.1)) THEN IF (group(l)(1:3).eq.'CHO') THEN fac=fac*0.34 ENDIF IF (group(l)(1:3).eq.'CO ') THEN fac=fac*0.90 ENDIF IF (INDEX(group(l),'CH2(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'CH(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'C(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'CO(O').NE.0) fac=fac*0.25 IF (INDEX(group(l),'CH2(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(l),'CH(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(l),'C(OH)').NE.0) fac=fac*1.6 ENDIF * find group on Ci IF ((bond(Ci,l).eq.1)) THEN IF (group(l)(1:3).eq.'CHO') THEN fac=fac*0.34 ENDIF IF (group(l)(1:3).eq.'CO ') THEN fac=fac*0.90 ENDIF IF (INDEX(group(l),'CH2(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'CH(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'C(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(l),'CO(O').NE.0) fac=fac*0.25 IF (INDEX(group(l),'CH2(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(l),'CH(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(l),'C(OH)').NE.0) fac=fac*1.6 ENDIF ENDDO * perform reaction * ---------------- * loop over the two possibilities for the OH radical addition to * the >C=C<. Swap Ci and Cf at the end of the do loop. DO i=1,2 nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c2' WRITE(6,'(a)') 'too many reactions created for species' WRITE(6,'(a)') chem WRITE(99,*) 'hoadd_c2',chem !STOP ENDIF flag(nr) = 1 * assign rate constant for OH addition in Ci position IF (nbcarbf.GT.nbcarbi) THEN tarrhc(nr,1)=kstruct*fac*0.8 tarrhc(nr,2)=0. tarrhc(nr,3)=0. ENDIF IF (nbcarbi.eq.nbcarbf) THEN tarrhc(nr,1)=kstruct*fac*0.5 tarrhc(nr,2)=0. tarrhc(nr,3)=0. ENDIF IF (nbcarbf.LT.nbcarbi) THEN tarrhc(nr,1)=kstruct*fac*0.2 tarrhc(nr,2)=0. tarrhc(nr,3)=0. ENDIF * 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 OH to Ci carbon and add radical dot to Cf nc = INDEX(tgroup(Ci),' ') tgroup(Ci)(nc:nc+3) = '(OH)' nc = INDEX(tgroup(Cf),' ') tgroup(Cf)(nc:nc) = '.' * rebuild, check, and find coproducts: CALL rebond(tbond,tgroup,tempkc,nring) CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) IF (nip.EQ.1) pchem(nr) = rdckprod(1) IF (nip.NE.1) STOP 'hoadd_c2.f' DO j=1,mca coprod(nr,j) = rdcktprod(1,j) ENDDO * 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) k=Ci Ci=Cf Cf=k k=nbcarbi nbcarbi=nbcarbf nbcarbf=k ENDDO END