************************************************************************ * MASTER MECHANISM - ROUTINE NAME : hoadd_c3 * * * * * * PURPOSE : * * This subroutine compute the reaction rate for OH addition on * * -CO-C=C-C=C-C=O bond (case 3) only. * * * * The method used is the SAR of Kwok and Atkinson, Atmos. Environ., * * 1685-1695, 1995. * * * * Note : 1-4 addition is not considered (expected to be small). * * Only 1-2 addition is considered. The yield is 50 % at each * * position. * * * * 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 * * - temp : reference temperature * * * * 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_c3(chem,bond,group, & ncd,conjug,cdtable,tcdtable,cdsub,cdcarbo, & 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, conjug INTEGER cdtable(4),tcdtable(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,ncoh,nco2,nc,nsub,nring 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),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) CHARACTER(LEN=lsb) :: progname='*hoadd_c3* ' 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 * Note : in cdtable, 1-2 and 3-4 indexes of cdtable are double bonded. * In tcdtable, non 0 indexes are terminal carbon (must in fact be at * index 1 or 4) c DO i=1,4 c print*,(cdcarbo(i,j),j=1,2) c ENDDO c print*,cdtable * check that everything is OK * update : this routine is now used for CO-C=C-C=C-CO and for * -C=C(CO)-C(CO)=C- c IF ( (cdcarbo(1,1).eq.0).and.(cdcarbo(4,1).eq.0) ) THEN c WRITE(6,'(a)') '--error--' c WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c3' c WRITE(6,'(a)') 'carbonyl expected at terminal position for' c WRITE(6,'(a)') chem c WRITE(99,*) 'hoadd_c3',chem !STOP c ENDIF * Assign rate constant for OH addition to the double bond. The -C=C-C=C- * structure is considered as a single structural unit. The rate * constant is a function of the number of substitutents, corrected by * the group factor (assumed to be 1 for alkyl). Total number of * substituents is 6 (2 at both end + 2 in the middle). * Note : The terminal positions of this structure must be position 1 * and 4 in cdtable. * count the number of substituents (remove 2 due to C-C bond in the * -C=C-C=C- structure) nsub=0 DO i=1,4 nsub=nsub+cdsub(i) ENDDO nsub=nsub-2 IF (nsub.eq.2) THEN kstruct=142E-12 ELSE IF (nsub.eq.3) THEN kstruct=190E-12 ELSE IF (nsub.gt.3) THEN kstruct=260E-12 ELSE WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c3' WRITE(6,'(a)') 'at least 2 substituents expected for' WRITE(6,'(a)') chem WRITE(99,*) 'hoadd_c3',chem !STOP ENDIF * take group contributions into account fac=1 DO i=1,4 DO j=1,mca IF (bond(cdtable(i),j).eq.1) THEN IF (group(j)(1:3).eq.'CHO') fac=fac*0.34 IF (group(j)(1:3).eq.'CO ') fac=fac*0.90 IF (INDEX(group(j),'CO(O').NE.0) fac=fac*0.25 IF (INDEX(group(j),'CH2(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(j),'CH(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(j),'C(ONO2)').NE.0) fac=fac*0.47 !IF (INDEX(group(j),'(ONO2)').NE.0) fac=fac*0.47 IF (INDEX(group(j),'CH2(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(j),'CH(OH)').NE.0) fac=fac*1.6 IF (INDEX(group(j),'C(OH)').NE.0) fac=fac*1.6 !IF (INDEX(group(j),'(OH)').NE.0) fac=fac*1.6 pbm COOH ENDIF ENDDO ENDDO kstruct=kstruct*fac * perform OH addition (only 1-2 addition is considered, 1-4 addition * is neglected). The same branching ratio is assumed for each * channel (kstruc/4). DO i=1,3,2 DO j=1,2 IF (j.eq.1) THEN ncoh=cdtable(i) nco2=cdtable(i+1) ELSE ncoh=cdtable(i+1) nco2=cdtable(i) ENDIF * add 1 to the channel counter nr = nr + 1 flag(nr) = 1 * assign rate constant for OH addition in Ci position tarrhc(nr,1)=kstruct*0.25 tarrhc(nr,2)=0. tarrhc(nr,3)=0. * convert Cf to single bond carbon tbond(ncoh,nco2)=1 tbond(nco2,ncoh)=1 pold = 'Cd' pnew = 'C' CALL swap(group(ncoh),pold,tgroup(ncoh),pnew) * convert Ci to single bond carbon pold = 'Cd' pnew = 'C' CALL swap(group(nco2),pold,tgroup(nco2),pnew) * add OH to ncoh carbon and add radical dot to nco2 nc = INDEX(tgroup(ncoh),' ') tgroup(ncoh)(nc:nc+3) = '(OH)' nc = INDEX(tgroup(nco2),' ') tgroup(nco2)(nc:nc) = '.' * rebuild, check, and find coproducts: CALL rebond(tbond,tgroup,tempkc,nring) CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) pchem(nr) = rdckprod(1) IF (nip.NE.1) THEN flag_del(nr) = 1 sc_del(nr,1) = sc(1) sc_del(nr,2) = sc(2) pchem_del(nr) = rdckprod(2) CALL stdchm(pchem_del(nr)) DO k=1,mca coprod_del(nr,k) = rdcktprod(2,k) ENDDO ENDIF DO k=1,mca coprod(nr,k) = rdcktprod(1,k) ENDDO * rename CALL stdchm(pchem(nr)) * reset: tgroup(ncoh) = group(ncoh) tgroup(nco2) = group(nco2) tbond(nco2,ncoh) = bond(nco2,ncoh) tbond(ncoh,nco2) = bond(ncoh,nco2) ENDDO ENDDO * check that the number of reaction performed does not exceed mnr IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : hoadd_c3' WRITE(6,'(a)') 'too many reactions created for species' WRITE(6,'(a)') chem WRITE(99,*) 'hoadd_c3',chem !STOP ENDIF END