************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rabsoh * * * * * * PURPOSE : * * Find rate constants for H-atom abstraction from VOC by HO based on * * Kwok & Atkinson (1995), Atmos. Environ., 29, 1685-1695, * * doi:10.1016/1352-2310(95)00069-B * * Bethel, HL, R Atkinson & J Arey (2001), International J. Chem. * * Kinetics, 33, 310-316, doi:10.1002/kin.1025 * * Excepted when noted, all values are taken from the original paper. * * * * Note : Activation temperatures are estimated from the rate * * constant function: k = A T**2 exp(-B/T) exp(Ex/T) * * where Ex is from substituent groups and A, B is from * * leaving "H" group * * * * JMLT, 9 Jan 2013: * * Removed double-activation for aldehydes, based on comparison with * * measurements of Baker, J., J. Arey, & R. Atkinson (2004), * * J. Phys. Chem. A, 108, 7032-7037, doi:10.1021/jp048979o * * exception: aldehyde in alpha position * * * * INPUT: * * - tgroup(i) : groups at position (carbon) i * * - tbond(i,j) : carbon-carbon bond matrix of chem * * - ig : group bearing the leaving H * * * * OUTPUT * * - arrhc(3) : arrhenius coefficient for H abstraction * * * ************************************************************************* SUBROUTINE rabsoh(tbond,tgroup,ig,arrhc,nring) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' INCLUDE 'common.h' * input INTEGER tbond(mca,mca) CHARACTER(LEN=lgr) tgroup(mca) INTEGER ig INTEGER nring * output REAL arrhc(3) * internal: INTEGER :: i,j,k REAL :: mult INTEGER :: nether,nca,rngflg,rgord,ring(mca) INTEGER :: o_sub(2),m_sub(2),p_sub(2) REAL :: Fph1(3),Fph2(3),path(6)!,k298 INTEGER :: track(mco,mca) INTEGER :: trlen(mco) INTEGER :: ntr IF (wtflag.NE.0) WRITE(*,*) & "*rabsoh*------------------------- ig = ",ig,' ',tgroup(ig) * ----------- * initialize * ----------- arrhc(:)=0. Fph1(:)=0. Fph2(:)=0. nca=0 DO i=1,mca IF (tgroup(i)(1:1).NE.' ') nca=nca+1 ENDDO * check ig value is ok IF (ig.GT.mca) THEN WRITE(6,*) '--error--, in rabsoh' WRITE(6,*) ' => ig is greater than mca' STOP ENDIF * ------------------ * FIND K(0) VALUE * ------------------ * Except when noted, values are from Kwok & Atkinson, Atmos. Env., 29, 1685 * (1995). For aldehyde, value is k-tertiary multiplied by the factor provided * for =O group. Aldehyde escapes modification by alpha or beta groups, based * on comparison with data of Baker et al, J. Phys. Chem. A, 108, 7032 (2004). * For -O-CH<, new Arrhenius constant was calculated to * fit the data for di-iso-propyl-ether (mean value: Mellouki 95, * Wallington 93, Nelson 90, Mc Loughlin 93) and isobutyl isopropyl * ether (Stemmler 97) ! August 2015 : updates in the frame of the MAGNIFY project, given by ! Mike Jenkin IF (tgroup(ig)(1:3).EQ.methyl) THEN arrhc(1) = 2.90E-12 arrhc(2) = 0 arrhc(3) = 925. ELSE IF(tgroup(ig)(1:3).EQ.primary) THEN arrhc(1) = 4.95E-12 arrhc(2) = 0 arrhc(3) = 555. ELSE IF(tgroup(ig)(1:3).EQ.aldehyde) THEN DO i=1,mca IF (tbond(ig,i).EQ.3) GOTO 20 ENDDO arrhc(1) = 2.12E-18 arrhc(2) = 2 arrhc(3) = -1340. ! JMLT: multiplier for alpha carbon (all cases except acetaldhyde) mult = 1.23 arrhc(3)=arrhc(3)-298.*log(mult) ! JMLT: no further activation for a, b positions on aldehyde. GOTO 20 ELSE IF(tgroup(ig)(1:2).EQ.secondary) THEN arrhc(1) = 3.17E-12 arrhc(2) = 0 arrhc(3) = 225. * ether but not ester DO i=1,mca IF (tbond(ig,i).EQ.3) THEN DO j=1,mca IF ((tbond(i,j).EQ.3).and.(j.ne.ig)) THEN IF (index(tgroup(j)(1:2),'CO').EQ.0) THEN arrhc(1) = 3.66E-19 arrhc(2) = 2 arrhc(3) = -696. GOTO 30 ENDIF ENDIF ENDDO ENDIF ENDDO ELSE WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : rabsoh' WRITE(6,'(a)') 'group not allowed to react with OH' WRITE(6,'(a)') tgroup(ig) STOP ENDIF 30 CONTINUE * --------------------------------------- * FIND MULTIPLIERS BASED ON SUBSTITUENTS * --------------------------------------- * and correct the activation energy only * on same carbon: mult = 1. IF (INDEX(tgroup(ig),hydroxy).NE.0) THEN c mult = 3.50 ! mult = 2.90 mult = 3.7 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (INDEX(tgroup(ig),nitrate).NE.0) THEN mult = 0.04 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * group contribution for -OOH is based following the comparaison * between rate constant for CH3OOH+OH -> CH2OOH and the rate * constant provided by Kwok for the CH3 group. This lead to * a factor 14 for the -OOH group at 298 K. IF (INDEX(tgroup(ig),hydro_peroxide) .NE. 0) THEN !mult = 14.0 ! Updated to 3.5 in 2014 as per Aumont / Jimenez / Atkinson / Tyndall discussions mult = 3.5 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * on alpha carbons: nether = 0 DO 10 i=1,mca mult = 1. IF (tbond(ig,i).NE.0) THEN * simple alkyl: IF (tgroup(i)(1:3).EQ.methyl) THEN mult = 1. arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:4) .EQ. 'CH2 ') THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:4) .EQ. 'CH2(') THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:3) .EQ. 'CH ' ) THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:3) .EQ. 'CH(' ) THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:2) .EQ. 'C(' ) THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF(tgroup(i)(1:2) .EQ. 'C ' ) THEN mult = 1.35 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF ! contribution of alcohol in beta position (Bethel et al., 2001) ! revised by Mike Jenkin, 2015, MAGNIFY IF (tgroup(i)(1:8).EQ.'CH2(OH) ') THEN mult = 2.4 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (tgroup(i)(1:7).EQ.'CH(OH) ') THEN mult = 2.4 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (tgroup(i)(1:6).EQ.'C(OH) ') THEN mult = 3.6 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * group contribution for alkenes (2009 factors given by JC Loison) c IF (tgroup(i)(1:2).EQ.'Cd') THEN c DO j=1,mca c IF ((tbond(i,j).NE.0).AND.(j.NE.ig)) THEN c IF (tgroup(j)(1:4) .EQ. 'CdH2' ) THEN c mult = 3 c arrhc(3)=arrhc(3)-298.*log(mult) c GOTO 42 c ELSE IF (tgroup(j)(1:3) .EQ. 'CdH' ) THEN c mult = 4 c arrhc(3)=arrhc(3)-298.*log(mult) c GOTO 42 c ENDIF c DO k=1,mca c IF ((tbond(j,k).NE.0).AND.(k.NE.i)) THEN c IF (tgroup(k)(1:2) .EQ. 'Cd' ) THEN c mult = 10 c arrhc(3)=arrhc(3)-298.*log(mult) c GOTO 42 c ENDIF c ENDIF c ENDDO c IF (tgroup(j)(1:2) .EQ. 'Cd' ) THEN c mult = 6 c arrhc(3)=arrhc(3)-298.*log(mult) c GOTO 42 c ENDIF c ENDIF c ENDDO c ENDIF c42 CONTINUE * overwrite for carbonyls, carboxylic acid and PAN values IF (tgroup(i)(1:2).EQ.carbonyl) THEN DO j=1,mca IF (tbond(i,j).EQ.3) mult = 0.31 ENDDO IF (mult.EQ.1.) mult = 0.75 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (tgroup(i)(1:3).EQ.aldehyde) THEN mult = 0.75 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (tgroup(i)(1:7).EQ.carboxylic_acid) THEN mult = 0.74 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF IF (INDEX(tgroup(i),nitrate).NE.0) THEN mult = 0.20 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * For PAN, koh is close to the rate constant for CH3 (respectively * 1.1E-13 and 1.36E-13). Therefore group factor for PAN was set to 1. IF (tgroup(i)(1:10).EQ.pan) THEN mult = 1.00 arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * Ethers and esters * For acetal, consider only one -O- influence IF (INDEX(tgroup(i),ether).NE.0) THEN DO j=1,mca IF ((tbond(i,j).EQ.3).AND.(j.ne.ig)) THEN IF (tgroup(j).EQ.aldehyde) THEN mult = 0.90 ELSE IF (tgroup(j).EQ.carbonyl) THEN mult = 1.60 ELSE nether = nether+1 IF (nether.LT.2) THEN mult = 8.4 ENDIF ENDIF ENDIF ENDDO arrhc(3)=arrhc(3)-298.*log(mult) ENDIF * Ring-strain contributions: only if ring present IF (nring.GT.0) THEN CALL findring(ig,i,mca,tbond,rngflg,ring) IF (rngflg.EQ.1) THEN * count ring members rgord=0 DO j=1,mca rgord=rgord+ring(j) ENDDO * rings with rgord > 5 have mult=1 mult=1.0 IF (rgord.EQ.3) mult=0.018 ! 3 members IF (rgord.EQ.4) mult=0.41 ! 4 members IF (rgord.EQ.5) mult=0.69 ! 5 members IF (rgord.EQ.6) mult=0.95 ! 6 members IF (rgord.EQ.7) mult=1.12 ! 7 members IF (rgord.EQ.8) mult=1.16 ! 8 members arrhc(3)=arrhc(3)-298.*log(mult) ENDIF ENDIF * on beta carbons: for -CH2CO- (but not -CO-O-), use MULT = 3.9. * Group contribution taken above for the CH2 or CH group must be removed IF (mult.EQ.1.23) THEN DO j=1,mca IF ((tbond(i,j).NE.0 ).AND. (j.NE.ig)) THEN IF (tgroup(j)(1:2).EQ.carbonyl) THEN DO k=1,mca IF ((tbond(j,k).EQ.1).AND.(k.NE.i)) THEN mult = 3.9 arrhc(3)=arrhc(3)-298.*log(mult)+298.*log(1.23) ENDIF ENDDO ENDIF ! JMLT: aldehyde in beta position should not increase activation IF (tgroup(j)(1:3).EQ.aldehyde ) THEN ! mult = 3.9 ! arrhc(3)=arrhc(3)-298.*log(mult)+298.*log(1.23) ENDIF ENDIF ENDDO ENDIF ! aromatic species, H abstraction only on branches IF (tgroup(i)(1:1).EQ.'c') THEN Fph1(1)=8.6 Fph1(3)=345 Fph2(1)=7.0 Fph2(3)=580 IF (tgroup(ig)(1:4).EQ.'CH3 ') THEN arrhc(1)=arrhc(1) * Fph1(1) arrhc(3)=arrhc(3) + Fph1(3) ELSE IF (tgroup(ig)(1:2).EQ.'CH') THEN arrhc(1)=arrhc(1) * Fph2(1) arrhc(3)=arrhc(3) + Fph2(3) ENDIF CALL arom_data(i,tgroup,tbond,nca,o_sub,m_sub,p_sub) DO k=1,2 IF (o_sub(k).NE.0) arrhc(3)=arrhc(3)-140 IF (p_sub(k).NE.0) arrhc(3)=arrhc(3)-140 ENDDO ENDIF ENDIF 10 CONTINUE * exit point 20 CONTINUE * end of rabsoh ! WRITE(6,*) 'H abs by OH rate : ',(arrhc(i),i=1,3) ! k298=arrhc(1)*EXP(-arrhc(3)/298.) ! WRITE(6,*) 'H abs by OH rate 298 : ',k298 RETURN END