************************************************************************ * MASTER MECHANISM - ROUTINE NAME : decompR)2NO2 * * * * * * PURPOSE : * * Decomposition of various non-radical molecule. At the moment * * * JMLT sensitivity study, June 2020: * Also decompose R-OONO2 -> RO2 + NO2 * * * In DECOMP each PAN group in CHEM is treated independently so * * that all possible break-up in R-CO(OO.) can be considered. * * The first section of DECOMP is the recognition of the PAN groups * * and change from a PAN group to a acyl-peroxy group respectively. * * The new chemical must then be rewritten in a standardized manner * * The second part of DECOMP collapses identical products and * * sums up the rate constants, respectively. * * In the third section DECOMP decides, if the products already * * exist in the dictionary, in the stack, or if the products should * * be loaded into the stack. Last but not least, the stoichiometric * * constant for the products and co-product NO2 will be set, and * * reaction is witten on screen in a standardized way (see: RXWRIT) * * * * INPUT: * * - rdct : name[a6]+formula[a120] of the species for which * * reaction with OH is considered * * - bond(i,j) : carbon-carbon bond matrix of chem * * - group(i) : groups at position (carbon) i * * - temp : reference temperature (more work on this needed) * * - 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 * * * * LITERATURE REFERENCES * * Tyndall, G. S., Cox, R. A., Granier, C., Lesclaux, R., Moortgat, G. * K., Pilling, M. J., Ravishankara, A. R., and Wallington, T. J., * Atmospheric chemistry of small organic peroxy radicals, J. Geophys. * Res., 106, 12, 157-12, 182, https://doi.org/10.1029/2000JD900746, 2001. ********************************************************************** SUBROUTINE decomp_RO2NO2(rdct,bond,group,nring,brch, & dbrch,dict,namlst, & cut_off, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' INCLUDE 'common.h' * input: CHARACTER(LEN=lcf) rdct CHARACTER(LEN=lgr) group(mca) INTEGER bond(mca,mca) INTEGER nring REAL brch REAL cut_off * 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) * internal: CHARACTER(LEN=lfo) pchem(mnr), tempkc CHARACTER(LEN=lgr) tgroup(mca), pold, pnew INTEGER tbond(mca,mca) INTEGER flag(mnr) INTEGER nr,nch,ich,i,j,k,np,nc,nca,onum,cnum REAL rate(mnr), brtio CHARACTER(LEN=lco) pp(mca) CHARACTER*1 a1, a2, a3, a4 CHARACTER(LEN=lco) r(3), p(mnp), prod(mnr,mca) REAL s(mnp), ar1,ar2,ar3,f298,fratio REAL arrh1(mnp),arrh2(mnp),arrh3(mnp),A REAL lowarrh1(mnp),lowarrh2(mnp),lowarrh3(mnp) REAL fc(mnp),k0M,ki,rapk,power INTEGER idreac, nlabel REAL xlabel,folow(3),fotroe(4) CHARACTER(LEN=lco) copchem REAL rdtcopchem CHARACTER(LEN=lfo) rdckprod(mca) CHARACTER(LEN=lco) rdcktprod(mca,mca) INTEGER nip REAL sc(mca) CHARACTER(LEN=lsb) :: progname='*decomp* ' CHARACTER(LEN=ler) :: mesg INTEGER iro2no2 * ---------- * INITIALIZE * ---------- IF(wtflag.NE.0) WRITE(*,*) progname copchem= ' ' rdtcopchem= 0. iro2no2 = 0 DO i=1,mnp arrh1(i)=0. arrh2(i)=0. arrh3(i)=0. lowarrh1(i)=0. lowarrh2(i)=0. lowarrh3(i)=0. fc(i)=0. ENDDO DO i=1,mnr pchem(i) = ' ' flag(i) = 0 rate(i) = 0. ENDDO DO i = 1, mca tgroup(i) = group(i) DO j=1,mca tbond(i,j)=bond(i,j) ENDDO ENDDO DO i=1,mnr DO j=1,mca prod(i,j) = ' ' ENDDO ENDDO DO i=1,mca pp(i) = ' ' ENDDO * count number of carbons: nc = INDEX(rdct(lco+1:lcf),' ') - 1 nca = cnum(rdct(lco+1:lcf),nc)+onum(rdct(lco+1:lcf),nc) * -------------------------------- * find RO2NO2 decomposition channel: * -------------------------------- nr = 0 DO 100 i=1,mca IF (INDEX(group(i),peroxy_nitrate).EQ.0) GO TO 100 IF (INDEX(group(i),pan).NE.0) GO TO 100 nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : decomp' WRITE(6,'(a)') 'too many reactions created for species' WRITE(6,'(a)') rdct(lco+1:lcf) STOP ENDIF flag(nr) = 1 * change (OONO2) to (OO.) pold = peroxy_nitrate pnew = alkyl_peroxy CALL swap(group(i),pold,tgroup(i),pnew) *rebuild, check and rename: CALL rebond(tbond,tgroup,tempkc,nring) CALL radchk(tempkc,rdckprod,rdcktprod,nip,sc) IF (nip.EQ.1) pchem(nr) = rdckprod(1) IF (nip.NE.1) STOP 'decomp.f' CALL stdchm(pchem(nr)) * other products are coproducts linked to pchem(nr) DO j = 1,mca prod(nr,j) = rdcktprod(1,j) ENDDO * PEROXY NITRATE NOT PAN LIKE FORBIDDEN * ------------------------------------- ! WRITE(6,*) '--error--, in decomp' ! WRITE(6,*) 'peroxy nitrate are not' ! WRITE(6,*) 'expected to be formed' ! WRITE(6,*) 'in that version' ! WRITE(6,*) 'check why the following species' ! WRITE(6,*) ' was produced:' ! WRITE(6,*) rdct * PEROXY NITRATE NOT PAN LIKE *ALLOWED* * JMLT sensitivity test, June 2020 * rates pers. comm. John Orlando * ------------------------------------- !PRINT*,"NON-PAN PEROXY NITRATE decomp" iro2no2 = 1 arrh1(nr) = 5.6E15 arrh2(nr) = 0. arrh3(nr) = 10440. * ------------------------------------- * reset: tgroup(i) = group(i) 100 CONTINUE *--------------------------------------- * ALL REACTIONS FOUND - TREAT REACTIONS *--------------------------------------- * collapse identical products: * ---------------------------- * this part is only done if the reaction rate are not * in the fall off regime (since in that case there is * no simple way to multiply reaction rate by 2 - in that * case reaction will be written 2 times) IF (nca.gt.2) THEN DO i=1,mnp-1 DO j=i+1,mnp IF (pchem(i).eq.pchem(j)) THEN flag(j) = 0 arrh1(i) = arrh1(i) + arrh1(j) ENDIF ENDDO ENDDO ENDIF nch = 0 DO i=1,mnp IF (flag(i).EQ.1) THEN nch = nch + 1 ENDIF ENDDO * ----------- * WRITE OUT * ----------- * following block needed for "postprocessing" only (operator reduction) IF (wtopeflag.EQ.1) THEN IF (nca.ne.2) THEN A = 0. DO i=1,mnr IF (flag(i).EQ.1) A = A + arrh1(i) ENDDO WRITE(10,'(A10,A1,A6,5X,A4,1X,ES10.3,1X,f4.1,1X,f7.0)') & '**** INIT ','G',rdct(1:lco),'****',A,arrh2(1),arrh3(1) ELSE WRITE(10,*)'**** INIT ','G',rdct(1:lco),' (+M) ','****' ENDIF ENDIF * loop over each reaction pathway * -------------------------------- ich = 10 DO 300 i=1,mnr IF (flag(i).EQ.0) GO TO 300 CALL rxinit3(a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) IF (wtopeflag.EQ.1) THEN !#write information required for operator IF (nca.EQ.2.AND.iro2no2.EQ.0) THEN !IF (nca.EQ.2)THEN WRITE(10,'(A6,E8.2,F5.1,F7.0,A1)') & 'LOW /',lowarrh1(i),lowarrh2(i),lowarrh3(i),'/' WRITE(10,'(A6,F3.1,A10)')'TROE /',fc(i), ' 0. 0. 0./' WRITE(10,'(E10.4,F5.1,F7.0)')arrh1(i),arrh2(i),arrh3(i) ENDIF ENDIF !# s(1) = 1. brtio = brch * s(1) * CALL bratio(pchem(i),brtio,p(1),copchem,rdtcopchem, CALL bratio(pchem(i),brtio,p(1), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) IF (wtopeflag.EQ.1) WRITE(10,'(f5.3,2X,A1,A6)') s(1), 'G',p(1) np = 1 DO j = 1,mca IF (prod(i,j)(1:1).NE.' ') THEN np = np + 1 IF (np.GT.mnp) THEN mesg = 'np > mnp (too many products in the reaction : 1)' CALL errexit(progname,mesg,chemfn) ENDIF s(np) = 1.0 p(np) = prod(i,j) * WRITE(10,'(f5.3,2X,A6)')s(np)*s(1),p(np) ENDIF ENDDO IF (rdtcopchem.GT.0.) THEN np = np + 1 IF (np.GT.mnp) THEN mesg = 'np > mnp (too many products in the reaction : 2)' CALL errexit(progname,mesg,chemfn) ENDIF s(np) = rdtcopchem p(np) = copchem * WRITE(10,'(f5.3,2X,A1,A6)')s(np)*ratio(i),'G',p(np) ENDIF * add NO2 in the reaction product np = np + 1 IF (np.GT.mnp) THEN mesg = 'np > mnp (too many products in the reaction : 3)' CALL errexit(progname,mesg,chemfn) ENDIF s(np) = 1. p(np) = 'NO2 ' IF (wtopeflag.EQ.1) & WRITE(10,'(f5.3,2X,A1,A6)')s(np)*s(1),'G',p(np) ich = ich + 1 IF (nch.GT.1) a4 = alfa(ich:ich) a1 = rdct(1:1) r(1) = rdct(1:lco) * CASE 1 : add (+M) in the reaction product (fall off, C=2) IF (nca.eq.2.AND.iro2no2.EQ.0) THEN r(2)='(+M)' np = np + 1 IF (np.GT.mnp) THEN mesg = 'np > mnp (too many products in the reaction : 4)' CALL errexit(progname,mesg,chemfn) ENDIF s(np) = 1. p(np) = '(+M) ' s(np) = 1. ar1 = arrh1(i) ar2 = arrh2(i) ar3 = arrh3(i) * compute reaction rate at 298K and atmospheric pressure k0M=lowarrh1(i)*((298./300.)**lowarrh2(i))* & exp(-lowarrh3(i)/298.)*2.45E19 ki=arrh1(i)*((298./300.)**arrh2(i))*exp(-arrh3(i)/298.) rapk=k0M/ki power=1./(1.+log10(rapk)*log10(rapk)) f298 = (k0m/(1.+rapk))*(fc(i)**power) fratio=1. * write out - fall off reaction are given with idreac=3 idreac=3 folow(1)=lowarrh1(i) folow(2)=lowarrh2(i) folow(3)=lowarrh3(i) fotroe(1)=fc(i) CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) * CASE 2 : regular thermal reaction (C>2) ELSE ar1 = arrh1(i) ar2 = arrh2(i) ar3 = arrh3(i) f298 = ar1*(298.**ar2)*exp(-ar3/298.) fratio=1. CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) ENDIF 300 CONTINUE * end of DECOMP. IF (wtopeflag.EQ.1) WRITE(10,*)'end' RETURN END