************************************************************************ * MASTER MECHANISM - ROUTINE NAME : hoadd_c1 * * * * * * PURPOSE : * * This subroutine compute the reaction rate for OH addition on * * >C=C< bond (case 1). Species having a C=O group conjugated with * * the C=C are not taken into account here * * * * The method used is the SAR of Peeters et al., 1997, "kinetic studies* * of reactions of alkylperoxy and haloalkylperoxy radicals with NO. * * A structure/reactivity relationship for reactions of OH with * * alkenes and polyalkenes", in Chemical processes in atmospheric * * oxidation, Eurotrac, G. Le Bras (edt) * * * * The method assumes that addition to a given Cd depends only on * * the structure (stability) of the addition products * * * * 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" * * * * 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 revation channel i * * * ************************************************************************* SUBROUTINE hoadd_c1(chem,bond,group,ncd,cdtable,conjug, & nr,flag,tarrhc,pchem,coprod,flag_del, & pchem_del,coprod_del,sc_del) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'common.h' * input: CHARACTER(LEN=lfo) chem INTEGER bond(mca,mca) CHARACTER(LEN=lgr) group(mca) INTEGER ncd INTEGER conjug INTEGER cdtable(4) * 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,j0,j1,j2,j3,nc INTEGER tbond(mca,mca), nring CHARACTER(LEN=lgr) tgroup(mca), pold, pnew CHARACTER(LEN=lfo) tempkc CHARACTER(LEN=lco) tprod(mca) REAL w1,w2 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 kadd INTEGER nca,cnum,xc * write info for finding bugs !WRITE(*,*) '*hoadd_c1*' * Initialize * ----------- DO i=1,mca tgroup(i)=group(i) DO j=1,mca tbond(i,j)=bond(i,j) ENDDO ENDDO * loop over each Cd DO 610 i=1,4 IF (cdtable(i).eq.0) GOTO 610 j0=cdtable(i) c IF (INDEX(group(i),'Cd').EQ.0) GOTO 610 nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c1' WRITE(6,'(a)') 'too many reactions created for species' WRITE(6,'(a)') chem WRITE(99,*) 'hoadd_c1',chem !STOP ENDIF flag(nr) = 1 * find partner double-bond carbons (j1 is beta position, j2 is * gamma position and j3 is delta position in C=C-C=C structure) j1 = 0 j2 = 0 j3 = 0 IF (i.eq.1) THEN j1=cdtable(2) IF (conjug.eq.1) THEN j2=cdtable(3) j3=cdtable(4) ENDIF ELSE IF (i.eq.2) THEN j1=cdtable(1) ELSE IF (i.eq.3) THEN j1=cdtable(4) ELSE IF (i.eq.4) THEN j1=cdtable(3) IF (conjug.eq.1) THEN j2=cdtable(2) j3=cdtable(1) ENDIF ENDIF ! trouve le nombre de carbon nc=INDEX(chem,' ')-1 nca = cnum(chem,nc) * treat non conjugated C=C bond * ----------------------------- IF (j3.EQ.0) THEN ! calcul de la constante d'addition total avec la SAR de Nishino, 2009. ! Dependant de la longueur de chaîne et de la stucture. ! rapport de Branchement calculé par Ziemann quand noté. IF (hoadd_c1_fg.eq.2) THEN IF (group(j0)(1:4).eq.'CdH2') THEN IF (group(j1)(1:4).eq. 'CdH2') THEN kadd=8.52E-12 !Atkinson 2003, ktot(ethene) tarrhc(nr,1)=kadd*0.5 ELSE IF (group(j1)(1:3).eq.'CdH') THEN xc=nca-3 kadd=2.8E-11+0.9E-11*(1-exp(-0.35*xc)) !Nishino tarrhc(nr,1)=kadd*0.70 !Ziemann ELSE IF (group(j1)(1:2).eq.'Cd') THEN xc=nca-4 kadd=5.1E-11+1.6E-11*(1-exp(-0.35*xc)) !Nishino tarrhc(nr,1)=kadd*0.70 !Ziemann ENDIF ELSE IF(group(j0)(1:3).eq.'CdH') THEN IF (group(j1)(1:4).eq. 'CdH2') THEN xc=nca-3 kadd=2.8E-11+0.9E-11*(1-exp(-0.35*xc))!Nishino tarrhc(nr,1)=kadd*0.30 !Ziemann ELSE IF (group(j1)(1:3).eq.'CdH') THEN xc=nca-4 kadd=6.3E-11+0.6E-11*(1-exp(-0.35*xc)) !Nishino tarrhc(nr,1)=kadd *0.5 !Ziemann ELSE IF (group(j1)(1:2).eq.'Cd') THEN xc=nca-4 kadd=8.69E-11+0.1E-11*(1-exp(-0.35*xc)) !3% de diff tarrhc(nr,1)=kadd *0.647 !meme rapport que Peeters ENDIF ELSE IF (group(j0)(1:2).eq.'Cd') THEN IF (group(j1)(1:4).eq.'CdH2') THEN xc=nca-4 kadd=5.1E-11+1.6E-11*(1-exp(-0.35*xc)) tarrhc(nr,1)=kadd*0.30 ELSE IF (group(j1)(1:3).eq.'CdH') THEN xc=nca-4 kadd=8.69E-11+0.1E-11*(1-exp(-0.35*xc)) !3% diff tarrhc(nr,1)=kadd *0.353 !meme rapport que Peeters ELSE IF (group(j1)(1:2).eq.'Cd') THEN xc=nca-4 kadd=10.3E-11+1.0E-11*(1-exp(-0.35*xc))!2% diff tarrhc(nr,1)=kadd *0.5 ENDIF ENDIF * assign rate constant ELSE IF (group(j1)(1:4).eq.'CdH2') THEN tarrhc(nr,1)=0.45E-11 ELSE IF (group(j1)(1:3).eq.'CdH') THEN tarrhc(nr,1)=3.0E-11 ELSE IF (group(j1)(1:2).eq.'Cd') THEN tarrhc(nr,1)=5.5E-11 ELSE WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c1' WRITE(6,'(a)') 'a carbon in a C=C bond was found with' WRITE(6,'(a)') 'no reactivity' WRITE(99,*) 'hoadd_c1',chem !STOP ENDIF ENDIF * set all value and rate constant tarrhc(nr,2)=0. tarrhc(nr,3)=0. * convert I to single bond carbon and change Cd to C tbond(j0,j1) = 1 tbond(j1,j0) = 1 pold = 'Cd' pnew = 'C' CALL swap(group(j0),pold,tgroup(j0),pnew) pold = 'Cd' pnew = 'C' CALL swap(group(j1),pold,tgroup(j1),pnew) * add (OH) to j0 carbon, add radical dot to j1: nc = INDEX(tgroup(j0),' ') tgroup(j0)(nc:nc+3) = '(OH)' nc = INDEX(tgroup(j1),' ') tgroup(j1)(nc:nc) = '.' * rebuild, check, and find co-products: CALL rebond(tbond,tgroup,tempkc,nring) CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) ! IF (nip.NE.1) STOP 'hoadd_c1.f' !JMLT, 15/7/2013 ! sc_del(nr,1) = sc(1) sc_del(nr,2) = sc(2) flag_del(nr) = 1 pchem_del(nr) = rdckprod(2) CALL stdchm(pchem_del(nr)) DO j=1,mca coprod_del(nr,j) = rdcktprod(2,j) ENDDO !JMLT, 15/7/2013 ! DO j=1,mca coprod(nr,j) = rdcktprod(1,j) ENDDO * rename CALL stdchm(pchem(nr)) * reset groups,bonds: tbond(j0,j1) = bond(j0,j1) tbond(j1,j0) = bond(j1,j0) tgroup(j0) = group(j0) tgroup(j1) = group(j1) ENDIF * treat conjugated C=C-C=C bond * ----------------------------- * assign rate constant for conjugated C=C bond (i.e radical formed * is a C.-C=C structure) and "weight" the 2 positions for the radical IF (j3.NE.0) THEN IF (group(j1)(1:3).eq.'CdH') THEN IF (group(j3)(1:4).eq.'CdH2') THEN tarrhc(nr,1)=3.0E-11 w1=3./(0.45+3.) w2=0.45/(0.45+3.) ELSE IF (group(j3)(1:3).eq.'CdH') THEN tarrhc(nr,1)=3.75E-11 w1=0.5 w2=0.5 ELSE IF (group(j3)(1:2).eq.'Cd') THEN tarrhc(nr,1)=5.05E-11 c w1=3./(3.+5.5) c w2=5.5/(3.+5.5) w1=5.5/(3.+5.5) w2=3./(3.+5.5) ENDIF ELSE IF (group(j1)(1:2).eq.'Cd') THEN IF (group(j3)(1:4).eq.'CdH2') THEN tarrhc(nr,1)=5.65E-11 w1=5.5/(0.45+5.5) w2=0.45/(0.45+5.5) ELSE IF (group(j3)(1:3).eq.'CdH') THEN tarrhc(nr,1)=8.35E-11 w1=5.5/(3.+5.5) w2=3./(3.+5.5) ELSE IF (group(j3)(1:2).eq.'Cd') THEN tarrhc(nr,1)=9.85E-11 w1=0.5 w2=0.5 ENDIF ENDIF * check that a rate constant was set IF (tarrhc(nr,1).EQ.0.) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c1' WRITE(6,'(a)') 'a carbon in a C=C bond was found with' WRITE(6,'(a)') 'no reactivity' WRITE(99,*) 'hoadd_c1',chem STOP ENDIF * FIRST RADICAL * set all value and rate constant c tarrhc(nr,1)=tarrhc(nr,1)*w1 tarrhc(nr,2)=0. tarrhc(nr,3)=0. * convert I to single bond carbon: tbond(j0,j1) = 1 tbond(j1,j0) = 1 pold = 'Cd' pnew = 'C' CALL swap(group(j0),pold,tgroup(j0),pnew) * convert J1 to single bond C pold = 'Cd' pnew = 'C' CALL swap(group(j1),pold,tgroup(j1),pnew) * add (OH) to I carbon, add radical dot to J1: nc = INDEX(tgroup(j0),' ') tgroup(j0)(nc:nc+3) = '(OH)' nc = INDEX(tgroup(j1),' ') tgroup(j1)(nc:nc) = '.' * rebuild, check, and find co-products: CALL rebond(tbond,tgroup,tempkc,nring) CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) sc_del(nr,1) = w1 sc_del(nr,2) = w2 flag_del(nr) = 1 pchem_del(nr) = rdckprod(2) CALL stdchm(pchem_del(nr)) DO j=1,mca coprod_del(nr,j) = rdcktprod(2,j) ENDDO DO j=1,mca coprod(nr,j) = rdcktprod(1,j) ENDDO * rename CALL stdchm(pchem(nr)) * reset groups,bonds: tbond(j0,j1) = bond(j0,j1) tbond(j1,j0) = bond(j1,j0) tgroup(j0) = group(j0) tgroup(j1) = group(j1) c* SECOND RADICAL c c nr=nr+1 c IF (nr.GT.mnr) THEN c WRITE(6,'(a)') '--error--' c WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c1' c WRITE(6,'(a)') 'too many reactions created for species' c WRITE(6,'(a)') chem c WRITE(99,*) 'hoadd_c1',chem !STOP c ENDIF c flag(nr) = 1 c c* set all value and rate constant (first reset the value) c tarrhc(nr,1)=tarrhc(nr-1,1)/w1 c tarrhc(nr,1)=tarrhc(nr,1)*w2 c tarrhc(nr,2)=0. c tarrhc(nr,3)=0. c c* convert I and j3 to single bond carbon: c tbond(j0,j1) = 1 c tbond(j1,j0) = 1 c tbond(j2,j3) = 1 c tbond(j3,j2) = 1 c c* convert i to single bond C c pold = 'Cd' c pnew = 'C' c CALL swap(group(j0),pold,tgroup(j0),pnew) c c* convert J3 to single bond C c pold = 'Cd' c pnew = 'C' c CALL swap(group(j3),pold,tgroup(j3),pnew) c c* add (OH) to I carbon, add radical dot to J3 and change the c* J1-J2 bond to a double bond: c nc = INDEX(tgroup(j0),' ') c tgroup(j0)(nc:nc+3) = '(OH)' c nc = INDEX(tgroup(j3),' ') c tgroup(j3)(nc:nc) = '.' c tbond(j1,j2) = 2 c tbond(j2,j1) = 2 c c* rebuild, check, and find co-products: c CALL rebond(tbond,tgroup,tempkc,nring) c CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) c pchem(nr) = rdckprod(1) c sc_del(nr,1) = sc(1) c IF (nip.EQ.2) THEN c flag_del(nr) = 1 c pchem_del(nr) = rdckprod(2) c sc_del(nr,2) = sc(2) c CALL stdchm(pchem_del(nr)) c DO j=1,mca c coprod_del(nr,j) = rdcktprod(2,j) c ENDDO c ENDIF c DO j=1,mca c coprod(nr,j) = rdcktprod(1,j) c ENDDO c c* rename c CALL stdchm(pchem(nr)) c * reset groups,bonds: DO k=1,mca tgroup(k) = group(k) DO l=1,mca tbond(k,l) = bond(k,l) ENDDO ENDDO ENDIF 610 CONTINUE END