************************************************************************ * MASTER MECHANISM - ROUTINE NAME : spreact * * * * PURPOSE: - perform the reaction that cannot be managed by the * * generator (eg aromatic chemistry) * * * * INPUT * * - rdct : species (code+formula) to manage * * - brch : used to give the yield of the species, but DOES * * NOT WORK ANYMORE - MORE WORK REQUIRED * * - 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 * * - noge : number of reaction given (oge=out of generator) * * - ogertve(i,3): reactants for reaction i. * * - ogeprod(i,j): products for the reaction i * * - ogearh(i,3) : arrehnius coefficients (A, n, Ea) * * - ogestoe(i,j): stochiometric coefficients for product j * * - ogelab(i) : label for the reaction (if EXTRA or HV) * * * * INPUT/OUTPUT * * - dbrch : NOT USED - MORE WORK ON THIS * * - 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 VOCs in the stack * * - nhldrad : number of radicals in the stack * * - holdrad(i) : list of the radicals in the stack * * - level : number of level (stable + radicals) that were * * necessary to produce the parent of "chem" * * - stabl : number of stable level (no radical) that were * * necessary to produce the parent of "chem" * ************************************************************************ SUBROUTINE spreact(rdct,brch, & dbrch,dict,namlst,nfn,namfn,chemfn, & noge,ogertve,ogeprod,ogearh,ogestoe,ogelab,ogeaux, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'common.h' * input: CHARACTER(LEN=lcf) rdct REAL brch CHARACTER(LEN=lfo) ogertve(mog,3) CHARACTER(LEN=lfo) ogeprod(mog,mnp) REAL ogearh(mog,3) REAL ogestoe(mog,mnp) REAL ogeaux(mog,7) INTEGER noge,ogelab(mog) INTEGER nfn CHARACTER(LEN=lco) namfn(mfn) CHARACTER(LEN=lfo) chemfn(mfn) * input/output CHARACTER(LEN=ldi) dict(mni) REAL dbrch(mni) CHARACTER(LEN=lco) namlst(mni) CHARACTER(LEN=lst) holdvoc(mlv) INTEGER nhldvoc CHARACTER(LEN=lst) holdrad(mra) INTEGER nhldrad INTEGER level INTEGER stabl * internal CHARACTER(LEN=lfo) chem CHARACTER(LEN=lco) name INTEGER i,j, nr, nhv, nex, ipos, nfo INTEGER noh, no3, nno3 CHARACTER*1 a1,a2,a3,a4 CHARACTER(LEN=lco) r(3), p(mnp) REAL s(mnp),ar1,ar2,ar3,f298,fratio REAL aroh,aro3,arno3 REAL brtio INTEGER idreac, nlabel REAL xlabel,folow(3),fotroe(4) !print*,"*spreact*" * initialize nr = 0 name = rdct(1:lco) chem = rdct(lco+1:lcf) noh = 0 no3 = 0 nno3 = 0 aro3 = 0. aroh = 0. arno3 = 0. * find reaction DO i=1,noge DO ipos=1,2 IF (chem.eq.ogertve(i,ipos)) THEN nr = nr + 1 IF (nr.GT.mnr) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : spreact' WRITE(6,'(a)') 'too many reactions created for species' WRITE(6,'(a)') rdct(lco+1:lcf) STOP ENDIF CALL rxinit3(a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) a1 = rdct(1:1) * set arrhenius coefficient ar1=ogearh(i,1) ar2=ogearh(i,2) ar3=ogearh(i,3) f298=ar1*(298.**ar2)*exp(-ar3/298.) fratio=1. brtio=brch * set the reactant of the reaction DO j=1,3 IF (j.eq.ipos) THEN r(j)=name ELSE IF (ogertve(i,j)(1:1).NE.' ') THEN CALL bratio(ogertve(i,j),brtio,r(j), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) ENDIF ENDDO * set the products of the reaction DO j=1,mnp IF (ogeprod(i,j)(1:1).NE.' ') THEN CALL bratio(ogeprod(i,j),brtio,p(j), & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) s(j)=ogestoe(i,j) ENDIF ENDDO * set id and label for the reaction (if necessary). For HV reaction, * weighting factor is set as the first value of ogeaux (ogeaux(i,1)). idreac=0 nlabel=0 nhv=0 nex=0 nfo=0 DO j=1,3 IF (ogertve(i,j)(1:3).eq.'HV ') THEN nhv=nhv+1 ENDIF IF (ogertve(i,j)(1:6).eq.'EXTRA ') THEN nex=nex+1 ENDIF IF (ogertve(i,j)(1:6).eq.'(+M) ') THEN nfo=nfo+1 ENDIF IF (ogertve(i,j)(1:3).eq.'HO ') THEN noh = noh+1 aroh = aroh+ar1 ENDIF IF (ogertve(i,j)(1:3).eq.'O3 ') THEN no3 = no3+1 aro3 = aro3+ar1 ENDIF IF (ogertve(i,j)(1:4).eq.'NO3 ') THEN nno3 = nno3+1 arno3 = arno3+ar1 ENDIF ENDDO IF (nhv+nex+nfo.gt.1) THEN WRITE(6,'(a)') '--error--' WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : spreact' WRITE(6,'(a)') 'too many keywords(EXTRA,HV) for species' WRITE(6,'(a)') rdct(lco+1:lcf) STOP ENDIF * photolysis IF (nhv.eq.1) THEN idreac=1 xlabel=ogeaux(i,1) nlabel=ogelab(i) ENDIF * extra IF (nex.eq.1) THEN idreac=2 nlabel=ogelab(i) ENDIF * Fall off reaction IF (nfo.eq.1) THEN idreac=3 DO j=1,3 folow(j)=ogeaux(i,j) ENDDO DO j=4,7 fotroe(j-3)=ogeaux(i,j) ENDDO ENDIF * write the reaction c CALL rxwrit2(a1,a2,a3,a4,r,s,p, c & ar1,ar2,ar3,f298,fratio,15) IF (wtopeflag.NE.0) CALL writopesp(a1,a2,a3,a4,r, & s,p,ar1,ar2,ar3,f298,fratio,idreac, & nlabel,xlabel) CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3, & f298,fratio,idreac,nlabel,xlabel,folow,fotroe) ENDIF ENDDO ENDDO * write net OH reaction rate IF(noh.NE.0)THEN WRITE(72,*) name,' ',aroh,ar2,ar3,' ',chem(1:index(chem,' ')) ENDIF * write net NO3 reaction rate IF(nno3.NE.0)THEN WRITE(71,*) name,' ',arno3,ar2,ar3,' ',chem(1:index(chem,' ')) ENDIF * write net O3 reaction rate IF(no3.NE.0)THEN WRITE(70,*) name,' ',aro3,ar2,ar3,' ', chem(1:index(chem,' ')) ENDIF IF (nr.eq.0) THEN WRITE (50,'(a)') '--WARNING--' WRITE (50,'(a)') 'The following species has no sink:' WRITE (50,'(a)') chem(1:LEN_TRIM(chem)) WRITE (50,'(a)') ' ' ENDIF RETURN END