************************************************************************ * MASTER MECHANISM - ROUTINE NAME : xcrieg * * * * * * PURPOSE : * * perform the reactions (decomposition, stabilization) of hot * * criegge produced by O3+alkene reactions. The routine returns the * * list of products and associated stoi. coef. in tables p (short * * name) and s, respectively. The dictionary, stack and related * * tables are updated accordingly. * * * * INPUT: * * - xcri : formula of the hot criegge * * - parent : parent alkene formula needed for stabilization yield* * - cut_off : ratio below which a pathway is not considered * * - dbrch : NOT USED - MORE WORK ON THIS NEEDED * * - level : number of level (stable + radicals) that were * * necessary to produce the parent of rdct * * - stabl : number of stable level (no radical) that were * * necessary to produce the parent of rdct * * - nfn : total nb. of species having a fixed name * * - namfn(i) : table of the fixed name (6 character) * * - chemfn(i) : formula corresponding the ith species having a * * fixed name * * * * INPUT/OUTPUT * * - dict(j) : dictionary line (name + formula + functional * * group info) of species number j * * - namlst(j) : name (lco=6 characters) of the species already * * used at position number j * * - nhldvoc : number of (stable) VOC in the stack * * - holdvoc(i) : list of the VOC in the stack * * - nhldrad : number of radical in the stack * * - holdrad(i) : list of the radicals in the stack * * * * OUTPUT: * * - s(i) : stoichiometric coef. associated with product i * * - p(i) : product i * ************************************************************************ SUBROUTINE xcrieg_cmv(xcri, & nc_parent, parent_bond, parent_group, & brch,s,p, & dbrch,dict,namlst, & cut_off, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'common.h' INCLUDE 'organic.h' * input: CHARACTER(LEN=lfo) xcri REAL brch REAL cut_off INTEGER nc_parent ! carbon skeleton size of parent alkene INTEGER parent_bond(mca, mca) ! parent alkene bond matrix INTEGER parent_group ! id of group in parent alkene ! which formed the criegee * input/output CHARACTER(LEN=ldi) dict(mni) REAL dbrch(mni) CHARACTER(LEN=lco) namlst(mni) INTEGER level INTEGER stabl CHARACTER(LEN=lst) holdvoc(mlv) INTEGER nhldvoc CHARACTER(LEN=lst) holdrad(mra) INTEGER nhldrad INTEGER nfn CHARACTER(LEN=lco) namfn(mfn) CHARACTER(LEN=lfo) chemfn(mfn) * output CHARACTER(LEN=lco) p(mnp) REAL s(mnp) * internal INTEGER cnum,onum,l CHARACTER(LEN=lfo) pchem(mnp),pchem1(mnp),pchem2(mnp),prod,prod2 CHARACTER(LEN=lfo) chemr1, chemr2 CHARACTER(LEN=lgr) tgroup(mca),group(mca),tempgr,pold, pnew CHARACTER(LEN=lco) coprod(mca),coprod_del(mca) INTEGER tbond(mca,mca),bond(mca,mca) INTEGER dbflg,nring INTEGER np,nc,nca,ig,j1,j2,i,j,nold,ngr INTEGER rjg(mri, 2) REAL sciyield, ohyield, otheryield, mult, tempyield INTEGER posj1,posj2 REAL ftherm,fdec1,fmol,yld1,yld2 REAL brtio REAL garrhc(3),c1,c2 CHARACTER(LEN=lco) copchem REAL rdtcopchem INTEGER rngflg ! 0 = 'no', 1 = 'yes' INTEGER ring(mca) ! =1 if node participates in current ring CHARACTER(LEN=lfo) rdckprod(mca) CHARACTER(LEN=lco) rdcktprod(mca,mca) INTEGER nip REAL sc(mca) CHARACTER(LEN=lfo) pchem_del INTEGER :: idci, idparent, k, nb, ntot, cdsub(2) * SAR data REAL :: beta(3), gamma(6), carbon_exponent INTEGER, PARAMETER :: idch2oo = 1 ! CH2OO INTEGER, PARAMETER :: idrchoo = 2 ! -CHOO = external CI INTEGER, PARAMETER :: idrrcoo = 3 ! >COO = internal CI INTEGER, PARAMETER :: idrchch2 = 1 ! -CH=CH2 INTEGER, PARAMETER :: idrrcch2 = 2 ! >C=CH2 INTEGER, PARAMETER :: idrrcchr = 3 ! >C=CH- INTEGER, PARAMETER :: idrchchr = 4 ! -CH=CH- INTEGER, PARAMETER :: idrrccrr = 5 ! >C=C< INTEGER, PARAMETER :: idch2ch2 = 6 ! CH2=CH2 IF(wtflag.NE.0) WRITE(*,*) '*xcrieg_cmv* -- input-- ',xcri beta(idch2oo) = 0.16 !beta(idrchoo) = 0.43 beta(idrchoo) = 0.32 beta(idrrcoo) = 0.73 gamma(idrchch2) = 0.34 gamma(idrrcch2) = 0.19 gamma(idrrcchr) = 0.14 ! gamma(idrchchr) = 0.09*z_conformer_prop+0.30*(1-z_conformer_prop) gamma(idrchchr) = 0.41 gamma(idrrccrr) = 0.33 gamma(idch2ch2) = 0.54 ! <- from Alam et al, 2011 carbon_exponent = 0 * initialize: np = 0 ig = 0 j2 = 0 rdtcopchem=0. pchem(:) = ' ' p(:) = ' ' s(:) = 0. * calling function to define number of carbons in hot Criegee nc = INDEX(xcri,' ') - 1 nca = cnum(xcri,nc)+onum(xcri,nc) ngr=0 DO i=1,mca IF (group(i).NE.' ') ngr=ngr+1 ENDDO * define functional groups and bond-matrix of hot Criegee and * store the data into bond and group CALL grbond(xcri,nc,group,bond,dbflg,nring) tgroup = group tbond = bond * find hot_criegge groups: DO i=1,mca IF (INDEX(tgroup(i),hot_criegee).NE.0) ig = i ENDDO IF (ig.EQ.0) THEN WRITE(6,'(a)') '--warning--(stop) in xcrieg_cmv' WRITE(6,'(a)') 'hot_criegge functional group not found in :' WRITE(6,'(a)') xcri WRITE(99,*) 'xcrieg',xcri STOP ENDIF * describe nature of parent alkene ! count substituent around the double bond ! that formed the criegee nb=0 cdsub = 0 DO j=1,mca IF ((parent_bond(parent_group,j).eq.1).OR. & (parent_bond(parent_group,j).eq.3)) THEN cdsub(1) = cdsub(1) + 1 ENDIF IF ((parent_bond(parent_group,j).eq.2)) THEN DO k = 1, mca IF((parent_bond(j,k) .eq. 1) .or. & (parent_bond(j,k) .eq. 3)) THEN cdsub(2) = cdsub(2) + 1 ENDIF ENDDO ENDIF ENDDO ntot = cdsub(1) + cdsub(2) IF (ntot .eq. 0) THEN idparent = idch2ch2 ELSE IF (ntot .eq. 1) THEN idparent = idrchch2 ELSE IF (ntot .eq. 2) THEN IF ((cdsub(1) .eq. 2) .or. (cdsub(2) .eq. 2)) THEN idparent = idrrcch2 ELSE idparent = idrchchr ENDIF ELSE IF (ntot .eq. 3) THEN idparent = idrrcchr ELSE IF (ntot .eq. 4) THEN idparent = idrrccrr ELSE WRITE(6,'(a)') '--warning--(stop) in xcrieg' WRITE(6,'(a)') 'parent structure of following criegee' WRITE(6,'(a)') 'could not be identified' WRITE(6,*) xcri, 'ntot = ', ntot WRITE(99,*) 'xcrieg',xcri ! STOP ENDIF * describe nature of CI IF (xcri(1:10).EQ.'CH2.(OO.)*') THEN idci = idch2oo ELSE j1 = 0 j2 = 0 * see if external or internal Criegee (internal:J2>0, external:J2=0): DO 210 i=1,mca IF (tbond(i,ig).EQ.0) GOTO 210 IF (j1.EQ.0) THEN j1 = i ELSE j2 = i ENDIF 210 CONTINUE IF(j2 .eq. 0) THEN idci = idrchoo ELSE idci = idrrcoo ENDIF ENDIF ! first calculate branching ratios from parent structure and ci structure sciyield = gamma(idparent)*nc_parent**(carbon_exponent) ohyield = min(1-sciyield, beta(idci)) IF(ohyield < cut_off) THEN !if stabilisation is the only significant pathway sciyield = 1.0 ohyield = 0. otheryield = 0. ELSE otheryield = 1 - ohyield - sciyield IF(otheryield < cut_off) THEN ! if 3rd pathway is neglected tempyield = sciyield/(sciyield + ohyield) ! rescale the sum of sciyield+ohyield to 1 ohyield = ohyield/(sciyield + ohyield) sciyield = tempyield otheryield = 0. ENDIF ENDIF * ----------------------------------------- * 1st section: single carbon hot criegees: * ------------------------------------------ IF (nca.EQ.1) THEN * OH yield for CH2.(OO.)* * The stabilized criegee radical is explicitely treated. * If criegee radical is * not specifically adressed below then the program stops. IF (idci .eq. idch2oo) THEN ! stabilisation sciyield = gamma(idparent)*nc_parent**(carbon_exponent) s(1) = sciyield pchem(1) = 'CH2.(OO.)' brtio = brch * s(1) * CALL bratio(pchem(1),brtio,p(1),copchem,rdtcopchem, CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) ! OH formation pathway ohyield = min(1-sciyield, beta(idch2oo)) s(2) = ohyield ! sum stab + oh pathway must not be >1 p(2) = 'CO ' s(3) = ohyield p(3) = 'HO2 ' s(4) = ohyield p(4) = 'HO ' ! non-OH forming decomposition pathway ! i.e. hot acid pathway. assume it makes CO otheryield = max(1 - sciyield - ohyield, 0.) s(5) = otheryield ! ensure it is not < 0 p(5) = 'CO ' RETURN ! escape routes for minor products of substituted ring-opening ! if criegee is "CH(OH).(OO.)" then assume NO conversion to acid, 100% yield. ELSE IF (xcri(1:13).EQ.'CH(OH).(OO.)*') THEN s(1) = 1.0 p(1) = 'CHO(OH) ' s(2) = 1.0 p(2) = 'NO2 ' RETURN ! JMLT June 2020 ! if criegee is "CH(OONO2).(OO.)" then assume NO3 elimination, 100% yield. ELSE IF (xcri(1:16).EQ.'CH(OONO2).(OO.)*') THEN pchem(1) = 'CHO(OO.) ' CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) s(1) = 1.0 s(2) = 1.0 p(2) = 'NO3 ' RETURN ! if criegee is "CH(ONO2).(OO.)" then assume NO2 elimination, 100% yield. ELSE IF (xcri(1:15).EQ.'CH(ONO2).(OO.)*') THEN pchem(1) = 'CHO(OO.) ' CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) s(1) = 1.0 s(2) = 1.0 p(2) = 'NO2 ' RETURN ! if criegee is "CH(OOH).(OO.)" then assume OH elimination, 100% yield. ELSE IF (xcri(1:14).EQ.'CH(OOH).(OO.)*') THEN pchem(1) = 'CHO(OO.) ' CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) s(1) = 1.0 s(2) = 1.0 p(2) = 'HO ' RETURN ! if criegee is "CO.(OO.)" then self-destruct, 100% yield. ELSE IF (xcri(1:9).EQ.'CO.(OO.)*') THEN s(1) = 1.0 p(1) = 'CO ' s(2) = 1.0 p(2) = 'O2 ' RETURN ELSE WRITE(6,'(a)') '--warning--(stop) in xcrieg' WRITE(6,'(a)') 'following C1 hot_criegge not found' WRITE(6,'(a)') 'in the routine. Change the program' WRITE(6,'(a)') 'accordingly.' WRITE(6,'(a)') xcri WRITE(99,*) 'xcrieg',xcri !STOP ENDIF ENDIF * ------------------------------------------- * 2nd section: multi-carbon hot criegees: * ------------------------------------------- * -------------------------------- * open chapter "external criegee" * -------------------------------- * First the program checks if the criegee radical is an alpha * carbonyl or alpha unsaturated carbon. If not, then perform * the reaction for the "regular" R-CH.(OO.)* criegee. IF (idci .eq. idrchoo) THEN IF (tgroup(ig)(1:9).EQ.'CH.(OO.)*') THEN * R-CH.(OO.) * Stabilization * ------------- ! stabilisation CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = sciyield ! replace hot_criegee by cold criegee pold = hot_criegee pnew = criegee tempgr=tgroup(ig) CALL swap(tempgr, pold, tgroup(ig), pnew) CALL rebond(tbond,tgroup,pchem(np),nring) CALL stdchm(pchem(np)) CALL bratio(pchem(np),brtio,p(np), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) * reset tgroup(:)=group(:) tbond(:,:)=bond(:,:) * oh formation decomposition channel (R. + CO + HO) * -------------------------------------- if (ohyield > 0.) THEN ! no need if the criegee is fully stabilized * add CO CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = ohyield p(np) = 'CO ' * add HO CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = ohyield p(np) = 'HO ' * add corresponding radical CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = ohyield tgroup(ig) = ' ' tbond(ig,j1) = 0 tbond(j1,ig) = 0 * if the group next to the criegee radical is an ether, * it must be converted into an alkoxy radical (ric nov 2008) IF (tgroup(j1).EQ.'-O-') THEN DO i=1,mca IF ((tbond(i,j1).NE.0).AND.(i.NE.ig)) THEN tbond(i,j1) = 0 tbond(j1,i) = 0 tgroup(j1) = ' ' nc = INDEX(tgroup(i),' ') tgroup(i)(nc:nc+3)='(O.)' ENDIF ENDDO ELSE nc = INDEX(tgroup(j1),' ') tgroup(j1)(nc:nc) = '.' ENDIF CALL rebond(tbond,tgroup,pchem(np),nring) * reset tgroup(:)=group(:) tbond(:,:)=bond(:,:) ENDIF 42 CONTINUE ! following MCM rules for decomposition pathway not yielding OH ! RCHOO -> 0.5 RO2 + 0.5 HO2 + RH + CO2 IF (otheryield > 0.) THEN ! only keep pathway if above cut_off * add CO2 CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield p(np) = 'CO2 ' * add HO2 CALL addprod(np,"xcrieg_cmv",xcri) ! np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 p(np) = 'HO2 ' * add RO2 CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 tgroup(ig) = ' ' tbond(ig,j1) = 0 tbond(j1,ig) = 0 * if the group next to the criegee radical is an ether, * it must be converted into an alkoxy radical (ric nov 2008) IF (tgroup(j1).EQ.'-O-') THEN DO i=1,mca IF ((tbond(i,j1).NE.0).AND.(i.NE.ig)) THEN tbond(i,j1) = 0 tbond(j1,i) = 0 tgroup(j1) = ' ' nc = INDEX(tgroup(i),' ') tgroup(i)(nc:nc+3)='(O.)' ENDIF ENDDO ELSE nc = INDEX(tgroup(j1),' ') tgroup(j1)(nc:nc) = '.' ENDIF CALL rebond(tbond,tgroup,pchem(np),nring) * reset tgroup = group tbond = bond * add RH CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 tgroup(ig) = ' ' tbond(ig, j1) = 0 tbond(j1, ig) = 0 CALL rjgrm(nring, tgroup, rjg) IF (tgroup(j1)(1:4) .eq. 'CH3 ') THEN tgroup(j1) = 'CH4 ' ELSE IF (tgroup(j1)(1:4) .eq. 'CH2 ') THEN !secondary CH2 tgroup(j1) = 'CH3 ' ELSE IF (tgroup(j1)(1:4) .eq. 'CH2(') THEN !primary substituted CH2 tgroup(j1)(3:3) = '3' ! replace 2 with 3 to make a C1 ELSE IF (tgroup(j1)(1:4) .eq. 'CdH ') THEN tgroup(j1) = 'CdH2 ' ELSE IF (tgroup(j1)(1:3) .eq. 'CH ') THEN tgroup(j1) = 'CH2 ' ELSE IF (tgroup(j1)(1:3) .eq. 'CH(') THEN tempgr = tgroup(j1)(3:index(tgroup(j1), ' ')) tgroup(j1)(1:3) = 'CH2' tgroup(j1)(4:lgr) = tempgr ELSE IF (tgroup(j1)(1:2) .eq. 'C ') THEN tgroup(j1)(1:2) = 'CH' ELSE IF (tgroup(j1)(1:2) .eq. 'C(') THEN tempgr = tgroup(j1)(2:index(tgroup(j1), ' ')) tgroup(j1)(1:2) = 'CH' tgroup(j1)(3:lgr) = tempgr ELSE IF (tgroup(j1)(1:3) .eq. 'Cd ') THEN tgroup(j1)(1:3) = 'CdH' ELSE IF (tgroup(j1)(1:3) .eq. 'Cd(') THEN tempgr = tgroup(j1)(3:index(tgroup(j1), ' ')) tgroup(j1)(1:3) = 'CdH' tgroup(j1)(4:lgr) = tempgr ELSE IF (tgroup(j1)(1:2) .eq. 'c ') THEN tgroup(j1)(1:2) = 'cH' ELSE IF (tgroup(j1)(1:2) .eq. 'CO') THEN pold = 'CO' pnew = 'CHO' tempgr=tgroup(j1) CALL swap(tempgr, pold, tgroup(j1), pnew) ELSE IF (tgroup(j1)(1:3) .eq. 'CHO') THEN tgroup(j1)(1:4) = 'CH2O' ELSE WRITE(6,*) 'problem in xcrieg_cmv for group:' WRITE(6,*) tgroup(j1) STOP ENDIF CALL rjgadd(nring, tgroup, rjg) CALL rebond(tbond,tgroup,pchem(np),nring) ENDIF GO TO 920 * escape routes for products of ring-opening (John Orlando, no reference) * if criegee is "R-C(OH).(OO.)*" then assume conversion to acid with NO, 100% yield. ! modif: assume full stabilisation because if we assume reaction with NO, ! that means that it has a long enough lifetime, i.e. it is stabilised ! very rare case ELSE IF (tgroup(ig)(1:12).EQ.'C(OH).(OO.)*') THEN CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 s(np) = 1.00 ! replace hot_criegee by cold criegee pold = hot_criegee pnew = criegee tempgr=tgroup(ig) CALL swap(tempgr, pold, tgroup(ig), pnew) CALL rebond(tbond,tgroup,pchem(np),nring) CALL stdchm(pchem(np)) CALL bratio(pchem(np),brtio,p(np), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) * reset tgroup(:)=group(:) tbond(:,:)=bond(:,:) GOTO 920 ! JMLT June 2020 * if criegee is "R-C(OONO2).(OO.)*" then assume NO3 elimination, 100% yield. ELSE IF (tgroup(ig)(1:15).EQ.'C(OONO2).(OO.)*') THEN s(2) = 1.0 p(2) = 'NO3 ' s(1) = 1.0 pold='C(OONO2).(OO.)*' pnew='CO(OO.)' tempgr=tgroup(ig) CALL swap(tempgr,pold,tgroup(ig),pnew) CALL rebond(tbond,tgroup,pchem(1),nring) CALL stdchm(pchem(1)) CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) GOTO 920 * if criegee is "R-C(ONO2).(OO.)*" then assume NO2 elimination, 100% yield. ! assume the same for now ELSE IF (tgroup(ig)(1:14).EQ.'C(ONO2).(OO.)*') THEN s(2) = 1.0 p(2) = 'NO2 ' s(1) = 1.0 pold='C(ONO2).(OO.)*' pnew='CO(OO.)' tempgr=tgroup(ig) CALL swap(tempgr,pold,tgroup(ig),pnew) CALL rebond(tbond,tgroup,pchem(1),nring) CALL stdchm(pchem(1)) CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) GOTO 920 * if criegee is "R-C(OOH).(OO.)*" then assume OH elimination, 100% yield. ! assume the same for now ELSE IF (tgroup(ig)(1:13).EQ.'C(OOH).(OO.)*') THEN s(2) = 1.0 p(2) = 'HO ' s(1) = 1.0 pold='C(OOH).(OO.)*' pnew='CO(OO.)' tempgr=tgroup(ig) CALL swap(tempgr,pold,tgroup(ig),pnew) CALL rebond(tbond,tgroup,pchem(1),nring) CALL stdchm(pchem(1)) CALL bratio(pchem(1),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) GOTO 920 ELSE * If the program continues up to this point for external criegee then * the criegee is not a -CH.(OO.) criegee. The program will stop. Add * some additional program lines if required. WRITE(6,'(a)') '--warning--(stop) in xcrieg' WRITE(6,'(a)') 'following external hot_criegge cannot be' WRITE(6,'(a)') 'computed. Please add some' WRITE(6,'(a)') 'additional fortran lines' WRITE(6,'(a)') xcri WRITE(99,*) 'xcrieg',xcri STOP ENDIF * end external criegee ENDIF * ----------------------------------------------- * else open chapter "internal criegees" * ----------------------------------------------- 456 CONTINUE ! DEBUG ! ! print*,"---internal criegee---" ! DEBUG ! * For -CH-C.(OO.)-C criegee radical, major evolution pathway is * expected to be the hydroperoxide channel (e.g. see Atkinson, 1999, * J. Chem. Ref. Data) : * -CH-C.(OO.)-C => -C=C(OOH)-C => -C.-CO-C + OH * This pathway is set with 100% yield. This mechanism requires an * H for the group in alpha position. Note that for H in -CHO, the * above mechanism is expected to not occur, because of the formation * of a strained transition state (see Carter, 1999, SAPRC99 mechanism). * Therefore, the program first checks the two group at alpha position IF (idci .eq. idrrcoo) THEN * check that that criegee make sense IF (tgroup(ig)(1:8).NE.'C.(OO.)*') THEN WRITE(6,'(a)') '--warning--(stop) in xcrieg_cmv' WRITE(6,'(a)') 'something wrong for the following' WRITE(6,'(a)') 'criegee radical (was first expected' WRITE(6,'(a)') 'to be C.(OO.)*' WRITE(6,'(a)') xcri WRITE(99,*) 'xcrieg',xcri STOP ENDIF ! JMLT April '17 ! * remove any ring flags from tgroups * CAUTION!! Note that this code allows formation of * CH3C1(CH3)C.(OO.)*C1CHO (carene mechanism) which is a * 3-membered ring Criegge and therefore highly strained. IF(nring.NE.0)THEN ! DEBUG ! ! PRINT*,"removing ring characters" ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! CALL rjgrm(nring,tgroup,rjg) ! CALL rjgrm(nring,tgroup(j2),rjg) ! DEBUG ! ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! ENDIF * check for CH groups posj1=1 posj2=1 IF (INDEX(tgroup(j1),'CH').EQ.0) posj1=0 IF (INDEX(tgroup(j2),'CH').EQ.0) posj2=0 ! if no CH group available, the VHP pathway is unavailable. ! assume stabilisation and non OH yielding decomposition only IF ( (posj1.EQ.0).AND.(posj2.EQ.0) ) THEN ohyield = 0 ! scale sciyield and otheryield sciyield = sciyield/(sciyield+otheryield) sciyield = anint(sciyield*1000)/1000 ! otheryield = otheryield/(sciyield+otheryield) otheryield = 1-sciyield ENDIF * if the carbon bearing the criegee belongs to a ring, the non OH ! yielding decomposition channel * leads to a di-radical species, which is not currently treated in the * generator. need update. (ric 2008) ! yep !CMV! 2016 CALL findring(ig,j1,nca,tbond,rngflg,ring) IF (ring(ig).EQ.1) THEN otheryield = 0. sciyield = sciyield/(sciyield+ohyield) sciyield = anint(sciyield*1000)/1000 ! ohyield = ohyield/(sciyield+ohyield) ohyield = 1-sciyield ENDIF ! stabilisation CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg_cmv' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = sciyield ! replace hot_criegee by cold criegee pold = hot_criegee pnew = criegee tempgr=tgroup(ig) ! DEBUG ! ! PRINT*,'swap 740' ! DEBUG ! CALL swap(tempgr, pold, tgroup(ig), pnew) CALL rebond(tbond,tgroup,pchem(np),nring) CALL stdchm(pchem(np)) CALL bratio(pchem(np),brtio,p(np), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) * reset tgroup = group tbond = bond * oh formation decomposition channel (RCOC(.)R + HO) * -------------------------------------- IF (ohyield > 0.) THEN * add HO CALL addprod(np,"xcrieg_cmv",xcri) s(np) = ohyield p(np) = 'HO ' * add corresponding radicals DO i=1,2 IF(i == 1) THEN IF(posj1 == 0) CYCLE mult = real(posj1)/(posj1+posj2) ! assume equiprobable pathways j = j1 ELSE IF(posj2 == 0) CYCLE mult = real(posj2)/(posj1+posj2) j = j2 ENDIF IF(nring.NE.0)THEN ! DEBUG ! ! PRINT*,"removing ring characters (inernal decomp channel)" ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! CALL rjgrm(nring,tgroup,rjg) ! DEBUG ! ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! ENDIF np = np + 1 IF (np.GT.mnp) THEN WRITE(6,'(a)') '--error-- in xcrieg' WRITE(6,'(a)') 'np is greater than mnp' WRITE(99,*) 'xcrieg',xcri !STOP ENDIF s(np) = ohyield*mult ! make beta acyl peroxyl radical RCOC.R ! make carbonyl function in place of criegee tgroup(ig) = carbonyl ! make radical at group(j) IF ( index(tgroup(j), 'CH3' ) /= 0) THEN pold = 'CH3' pnew = 'CH2' ELSEIF ( index(tgroup(j), 'CH2' ) /= 0) THEN pold = 'CH2' pnew = 'CH' ELSEIF ( index(tgroup(j), 'CH' ) /= 0) THEN pold = 'CH' pnew = 'C' ENDIF tempgr = tgroup(j) ! DEBUG ! ! PRINT*,'swap 804' ! DEBUG ! CALL swap(tempgr, pold, tgroup(j), pnew) CALL adddot(tgroup(j)) CALL rebond(tbond, tgroup, pchem(np), nring) * reset tgroup = group tbond = bond ENDDO ENDIF * 3rd decomposition channel (R1C(.OO.)R2 -> 0.5R1. + 0.5R2. + 0.5R1-R2 + CO2) * -------------------------------------- IF (otheryield > 0.) THEN IF(nring.NE.0)THEN ! DEBUG ! ! PRINT*,"removing ring characters (3rd channel)" ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! CALL rjgrm(nring,tgroup,rjg) ! CALL rjgrm(nring,tgroup(j2),rjg) ! DEBUG ! ! print*,j1,tgroup(j1),j2,tgroup(j2) ! DEBUG ! ENDIF * add CO2 CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield p(np) = 'CO2 ' ! add R1-R2 CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 tgroup(ig) = ' ' tbond(ig, j1) = 0 tbond(j1, ig) = 0 tbond(ig, j2) = 0 tbond(j2, ig) = 0 tbond(j1, j2) = 1 tbond(j2, j1) = 1 CALL rebond(tbond, tgroup, pchem(np), nring) * reset tgroup = group tbond = bond ! form R1. and R2. tgroup(ig) = ' ' tbond(ig, j1) = 0 tbond(j1, ig) = 0 tbond(ig, j2) = 0 tbond(j2, ig) = 0 CALL adddot(tgroup(j1)) CALL adddot(tgroup(j2)) CALL fragm(tbond, tgroup, chemr1, chemr2) CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 pchem(np) = chemr1 CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) THEN ! WRITE(6,'(a)') '--error-- in xcrieg' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = otheryield*0.5 pchem(np) = chemr2 * reset tgroup = group tbond = bond ENDIF * reset tgroup(:)=group(:) tbond(:,:)=bond(:,:) ENDIF * ------------------------------------------------------ * check the various product and load species in the * stack (if required). * ------------------------------------------------------ 920 nold = np DO 950 i=1,nold IF (pchem(i)(1:1).EQ.' ') GO TO 950 prod = pchem(i) pchem_del=' ' coprod_del(:) = ' ' IF (INDEX(pchem(i),'.').NE.0) THEN CALL radchk(prod,rdckprod,rdcktprod,nip,sc) pchem(i) = rdckprod(1) IF (nip.EQ.2) THEN pchem_del = rdckprod(2) DO j=1,mca coprod_del(j) = rdcktprod(2,j) ENDDO ENDIF DO l = 1,mca coprod(l) = rdcktprod(1,l) ENDDO DO j=1,mca IF (coprod(j)(1:1).NE.' ') THEN np = np + 1 IF (np.GT.mnr) THEN WRITE(6,'(a)') '--error-- in xcrieg' WRITE(6,'(a)') 'np is greater than mnr' WRITE(99,*) 'xcrieg',xcri STOP ENDIF s(np)=s(i) p(np) = coprod(j) ENDIF ENDDO DO j=1,mca IF (coprod_del(j)(1:1).NE.' ') THEN WRITE(6,*) pchem_del WRITE(6,*) coprod_del(j) np = np + 1 IF (np.GT.mnr) THEN WRITE(6,'(a)') '--error-- in xcrieg' WRITE(6,'(a)') 'np is greater than mnr' WRITE(99,*) 'xcrieg',xcri STOP ENDIF s(np)=sc(2) p(np) = coprod_del(j) ENDIF ENDDO ENDIF CALL stdchm(pchem(i)) IF (nip.EQ.2) s(i)=s(i)*sc(1) brtio = brch * s(i) CALL bratio(pchem(i),brtio,p(i), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) IF (nip.EQ.2) THEN CALL addprod(np,"xcrieg_cmv",xcri) !np=np+1 s(np)=(s(i)*sc(2))/sc(1) brtio = brch * s(np) CALL bratio(pchem_del,brtio,p(np), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) ENDIF IF (rdtcopchem.GT.0.) THEN CALL addprod(np,"xcrieg_cmv",xcri) !np = np + 1 !IF (np.GT.mnp) then ! WRITE(6,'(a)') '--error-- in ho_rad' ! WRITE(6,'(a)') 'np is greater than mnp' ! WRITE(6,'(a)') '(too much product in the reaction)' ! WRITE(99,*) 'xcrieg',xcri !STOP !ENDIF s(np) = rdtcopchem p(np) = copchem ENDIF IF(wtflag.NE.0) WRITE(*,*)'*xcrieg_cmv* --product-- ',i,pchem(i) 950 CONTINUE END SUBROUTINE xcrieg_cmv