************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rxmeo2ro2 * * * * PURPOSE: write the CH3O2+RO2 reactions in the the output file * * * * INPUT: * * OUTPUT: none - the reactions are just written in the output file * * in mechanism given in the output (unit lout) * * * * NOTE: Data in this file must be similar to those in ro2.f and * * rcoo2.f. CH3O2+CH3O2 reactions are in the C1 chemistry file * ************************************************************************ SUBROUTINE rxmeo2ro2 IMPLICIT NONE INCLUDE 'general.h' CHARACTER*1 a1, a2, a3, a4 CHARACTER(LEN=lco) p(mnp), r(3) CHARACTER*5 wrtnum REAL arrh1,arrh2,arrh3 REAL xlabel,folow(3),fotroe(4) REAL s(mnp), ar1,ar2,ar3,f298,fratio REAL rrad,rmol,rmol1,rmol2,check INTEGER i,j, itype, idreac, nlabel REAL ch3o2dat(3),rco3dat(3),ro2dat(8,3) * data for CH3O2 (from Tyndall 2001) DATA(ch3o2dat(i),i=1,3) /9.5E-14, -390., 0.37/ * data for RCO3 (from Tyndall 2001 for CH3COO2) DATA(rco3dat(i),i=1,3) /2.5E-12, -500., 1.0/ * data for RO2: (from Lesclaux 97) * itype 1 : linear primary RO2 * itype 2 : branched primary RO2 * itype 3 : alpha or beta O substitued primary RO2 * itype 4 : CH3CH(OO.)CH3 * itype 5 : secondary RO2 (C>3) * itype 6 : alpha or beta O substitued secondary RO2 * itype 7 : Tertiary RO2 * itype 8 : alpha or beta O substitued tertiary RO2 DATA(ro2dat(1,i),i=1,3) /5.6E-14, -500., 0.6/ DATA(ro2dat(2,i),i=1,3) /7.8E-15, -1500., 0.5/ DATA(ro2dat(3,i),i=1,3) /7.1E-14, -1200., 0.6/ DATA(ro2dat(4,i),i=1,3) /1.7E-12, 2200., 0.6/ DATA(ro2dat(5,i),i=1,3) /1.0E-10, 2200., 0.6/ DATA(ro2dat(6,i),i=1,3) /8.4E-15, -1300., 0.3/ DATA(ro2dat(7,i),i=1,3) /4.1E-11, 4200., 1.0/ DATA(ro2dat(8,i),i=1,3) /3.0E-13, 1220., 1.0/ * ------------------------------------------- * initialize * ------------------------------------------- a1=' ' a2=' ' a3=' ' a4=' ' DO i=1,3 r(i)=' ' folow(i)=0. ENDDO DO i=1,4 fotroe(i)=0. ENDDO DO i=1,mnp s(i)=0. p(i)=' ' ENDDO idreac=0 nlabel=0 * ------------------------------------------- * loop over the various RO2 counting species * ------------------------------------------- DO 100 itype=1,8 * omit reactions with some particular counters (must be the same in * subroutine ro2.f and rcoo2.f) IF (itype.eq.4) GOTO 100 IF (itype.eq.7) GOTO 100 IF (itype.eq.8) GOTO 100 * compute the branching ratio rmol=( (1.-ch3o2dat(3)) + (1.-ro2dat(itype,3)) )/2. rrad=1.-rmol * If radical channel for the processed counter is not equal to 1, then * divide the molecular channel in two parts. In what follows, rmol1 is * for H given by CH3O2 (to the counters) and rmol2 is for "H taken" * by CH3O2 by CH3o2 (form the counters) IF (ro2dat(itype,3).eq.1.) THEN rmol1=rmol rmol2=0. ELSE rmol1=rmol/2. rmol2=rmol/2. ENDIF * change stoichiometric coefficient in such a way that sum makes 1 * when writing the results. This is done by changing rrad. ! next lines are used to reduce precision of rmol to 2 decimal places ! DOES NOT work with Cheyenne compiler !WRITE(wrtnum,'(f5.2)') rmol1 !READ(wrtnum,'(f5.2)') rmol1 !WRITE(wrtnum,'(f5.2)') rmol2 !READ(wrtnum,'(f5.2)') rmol2 ! precision reduction: works with Cheyenne compiler rmol1 = FLOAT(NINT(rmol1*100.))/100. rmol2 = FLOAT(NINT(rmol2*100.))/100. ! end precision reduction check=1.-rmol1-rmol2 IF (abs((check-rrad)/rrad).gt.0.03) THEN WRITE(6,*) '--error-- in RO2 (treating CH3O2 reaction)' WRITE(6,*) 'something wrong in overwriting stoe. coef.' STOP ENDIF rrad=check * initialize reaction CALL rxinit3(a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) * set reactants r(1)='CH3O2' IF (itype.EQ.1) r(2)='PERO1' IF (itype.EQ.2) r(2)='PERO2' IF (itype.EQ.3) r(2)='PERO3' IF (itype.EQ.4) r(2)='PERO4' IF (itype.EQ.5) r(2)='PERO5' IF (itype.EQ.6) r(2)='PERO6' IF (itype.EQ.7) r(2)='PERO7' IF (itype.EQ.8) r(2)='PERO8' * set rate constant : (2*geometric mean) ar1 = 2.*( (ch3o2dat(1)*ro2dat(itype,1)) )**0.5 ar2 = 0. ar3 = (ch3o2dat(2)+ro2dat(itype,2))/2. f298 = ar1*(298.**ar2)*exp(-ar3/298.) fratio=1. * radical channel s(1)=rrad p(1) = 'CH3O ' * H given by CH3O2 s(2)=rmol1 p(2) = 'CH2O ' * H taken by CH3O2 s(3) = rmol2 p(3) = 'CH3OH' CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) 100 CONTINUE * ------------------------------------------- * reaction with rco3 * ------------------------------------------- * compute the branching ratio rmol=(1.-ch3o2dat(3))/2. rrad=1.-rmol * change stoechiometric coefficient in such a way that sum make 1 * when writing the results. This is done by changing rrad. WRITE(wrtnum,'(f5.2)') rmol READ(wrtnum,'(f5.2)') rmol check=1.-rmol IF (abs((check-rrad)/rrad).gt.0.02) THEN WRITE(6,*) '--error-- in RO2 (treating CH3O2 reaction)' WRITE(6,*) 'something wrong in overwriting stoe. coef.' STOP ENDIF rrad=check * initialize reaction CALL rxinit3(a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) * rate constant : Data available shows that the reaction rate * is close to 1E-11, independant of the RO2 being considered. This * rate constant is used, instead of the classical geometrical mean C arrh1 = 2.*( (rco3dat(1)*ch3o2dat(itype,1)) )**0.5 C arrh2 = 0. C arrh3 = (rco3dat(2)+ro2dat(itype,2))/2. C f298 = arrh1*(298.**arrh2)*exp(-arrh3/298.) ar1 = 1.0E-11 ar2 = 0. ar3 = 0. f298 = ar1*(298.**ar2)*exp(-ar3/298.) fratio=1. r(1) = 'CH3O2' r(2) = 'PERO9' * radical channel s(1)=rrad p(1) = 'CH3O ' * H given by CH3O2 to the counter s(2)=rmol p(2) = 'CH2O ' CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) WRITE(6,*) 'done CH3O2+RO2 reactions' END