************************************************************************ * MASTER MECHANISM - ROUTINE NAME : rdoutgene * * * * PURPOSE: - read the chemical scheme that cannot be managed by the * * generator (eg aromatic chemistry) * * * * INPUT * * - ninorg : number of inorganic species * * - inorglst(j) : list of inorganic species - includes the name + * * formula + functional group info * * - nrec : number of species recorded * * - dict(j) : dictionary line (name + formula + functional * * group info) for species j * * - nspsp : total number of "special" species (e.g. furane) * * - dictsp(i) : list of the "known" special species * * * * OUTPUT * * - noge : number of reactions given (oge=out of generator) * * - ogertve(i,3): reactants for reaction i. * * - ogeprod(i,j): products for 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) * * - ogeaux(i,7) : auxiliary information for reaction i (e.g. data for * * fall off reaction) * * * * The program checks if the species in a reaction are "known" in the * * generator. If not, the program stops. * ************************************************************************ SUBROUTINE rdoutgene(filename,ifile, & ninorg,inorglst, & nrec,dict, & nspsp,dictsp, & noge,ogertve,ogeprod,ogearh,ogestoe,ogelab, & ogeaux) IMPLICIT NONE INCLUDE 'general.h' * input INTEGER ninorg INTEGER ifile ! # of input file CHARACTER(LEN=ldi) inorglst(mfn) INTEGER nrec CHARACTER(LEN=ldi) dict(mni) CHARACTER(LEN=llin) filename INTEGER nspsp CHARACTER(LEN=ldi) dictsp(mfn) * output 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) * internal CHARACTER(LEN=ldi) line,line1,line2,line3 CHARACTER(LEN=lfo) chem1,chem2 INTEGER n1,n2,i,j,nlin,nca,i_val,cnum,ierr,ifo REAL r_val LOGICAL locheck, lohv * ------------- * INITIALISE ONLY THE FIRST TIME AROUND * ------------- IF(ifile.EQ.1)THEN noge=0 DO i=1,mog ogelab(i)=0 DO j=1,3 ogertve(i,j)=' ' ogearh(i,j)=0. ENDDO DO j=1,7 ogeaux(i,j)=0. ENDDO ENDDO DO i=1,mog DO j=1,mnp ogeprod(i,j)=' ' ogestoe(i,j)=0. ENDDO ENDDO ENDIF * ------------- * OPEN THE FILE * ------------- !OPEN(10,FILE=filename, FORM='FORMATTED',STATUS='OLD') OPEN(10,FILE=filename,STATUS='OLD') * ------------- * READ THE FILE * ------------- 20 READ (10,'(a)',err=999) line IF (line(1:3).eq.'END') GOTO 30 IF (line(1:1).eq.'*') GOTO 20 * NEW REACTION - GET THE NUMBER OF LINE TO BE READ * ------------------------------------------------ IF (line(1:4).EQ.'REAC') THEN noge=noge+1 * get the total number of line necessary to read the reaction nlin=i_val(line,1,ldi,2,ierr) IF (ierr.NE.0) THEN WRITE(6,*) ' --error--, in rdoutgene. Cannot read' WRITE(6,*) 'integer at line :' WRITE(6,*) line(1:30) STOP ENDIF IF (nlin.le.0) THEN WRITE(6,*) '--error--, in rdoutgene. Number of line ' WRITE(6,*) 'to be read after "REAC" must be at least 1' STOP ENDIF * READ THE REACTANTS - ARRHENIUS PARAMETERS - LABEL * -------------------------------------------------- READ (10,'(a)',err=998) line n1=INDEX(line,';') n2=INDEX(line,'&') IF (n1.EQ.0) THEN WRITE(6,*) ' --error--, in rdoutgene. Character ";" expected' WRITE(6,*) 'but not found at line :' WRITE(6,*) line(1:40) STOP ENDIF IF (n2.EQ.0) THEN WRITE(6,*) ' --error--, in rdoutgene. Character "&" expected' WRITE(6,*) 'but not found at line :' WRITE(6,*) line(1:40) STOP ENDIF * split the line in 3 parts line1=' ' line2=' ' line3=' ' line1=line(1:n1-1) ! 2 reactants line2=line(n1+1:n2-1) ! 3 Arrhenius coefficients line3=line(n2+1:) ! auxiliary info (for fall-off reaction only) * get the 2 reactants - first the special species then the coreactant chem1=' ' chem2=' ' IF (line1(1:1).EQ.' ') THEN WRITE(6,*) ' --error--, in rdoutgene. Character expected' WRITE(6,*) 'but not found at the first position of line :' WRITE(6,*) line1(1:30) STOP ENDIF n2=INDEX(line1,' + ') ifo=INDEX(line,'(+M)') IF (n2.ne.0) THEN chem1=line1(1:n2) ELSE chem1=line1(1:n1-1) ENDIF IF (n2.ne.0) THEN chem2=line1(n2+3:) IF (chem2(1:1).eq.' ') THEN WRITE(6,*) ' --error--, in rdoutgene. Coreactant' WRITE(6,*) 'start with a " " at line :' WRITE(6,*) line(1:60) WRITE(6,*) 'separation between the 2 species must be " + "' STOP ENDIF ENDIF * check for fall-off reaction - remove the flag '(+M)' stored in chem IF (ifo.ne.0) THEN i=INDEX(chem1,'(+M)') IF (i.ne.0) chem1(i:i+4)=' ' i=INDEX(chem2,'(+M)') IF (i.ne.0) chem2(i:i+4)=' ' ENDIF * check that the special species are known CALL chcksp(ninorg,inorglst, & nrec,dict, & nspsp,dictsp, & chem1) IF (n2.NE.0) THEN CALL chcksp(ninorg,inorglst, & nrec,dict, & nspsp,dictsp, & chem2) ENDIF * put the species in the table of reactant ogertve(noge,1)=chem1 ogertve(noge,2)=chem2 * add the fall off flag if required IF (ifo.ne.0) THEN IF (ogertve(noge,2)(1:1).EQ.' ') THEN ogertve(noge,2)='(+M)' ELSE ogertve(noge,3)='(+M)' ENDIF ENDIF * get the arrhenius coefficients (must read 3 values) DO i=1,3 ogearh(noge,i)=r_val(line2,1,ldi,i,ierr) IF (ierr.ne.0) THEN WRITE(6,*) '--error-- in the routine rdoutgene.' WRITE(6,*) 'Cannot read arrhenius coefficient number ',i WRITE(6,*) 'at line' WRITE(6,*) line(1:60) STOP ENDIF ENDDO * get the label (only if EXTRA or HV is the coreactant) locheck=.false. lohv=.false. IF (chem2(1:6).eq.'EXTRA ') locheck=.true. IF (chem2(1:3).eq.'HV ') THEN locheck=.true. lohv=.true. ENDIF IF (locheck) THEN ogelab(noge)=i_val(line3,1,ldi,1,ierr) IF (ierr.ne.0) THEN WRITE(6,*) '--error-- in the routine rdoutgene.' WRITE(6,*) 'Cannot read label number at line :' WRITE(6,*) line(1:60) STOP ENDIF IF (lohv) THEN ogeaux(noge,1)=r_val(line3,1,ldi,2,ierr) IF (ierr.ne.0) THEN WRITE(6,*) '--error-- in the routine rdoutgene.' WRITE(6,*) 'Cannot read scaling factor (HV) at line :' WRITE(6,*) line(1:60) STOP ENDIF ENDIF ENDIF * get auxiliary information - for fall off reaction only IF (ifo.ne.0) THEN READ(10,'(a)',err=996) line DO i=1,7 ogeaux(noge,i)=r_val(line,1,ldi,i,ierr) IF (ierr.ne.0) THEN WRITE(6,*) '--error-- in the routine rdoutgene.' WRITE(6,*) 'Cannot read auxiliary information ' WRITE(6,*) 'at line :' WRITE(6,*) line(1:60) WRITE(6,*) 'data number :',i STOP ENDIF ENDDO ENDIF * GET THE PRODUCTS AND STOICHEOMETRIC COEFFICIENTS * ------------------------------------------------ nlin=nlin-1 IF (ifo.ne.0) nlin=nlin-1 DO 400 j=1,nlin READ(10,'(a)',err=997) line n1=INDEX(line,' ')-1 chem1=line(1:n1) * check the product (#, C1 or inorganic species) CALL chcksp(ninorg,inorglst, & nrec,dict, & nspsp,dictsp, & chem1) * set product and get the stoichiometric coefficient ogeprod(noge,j)=chem1 ogestoe(noge,j)=r_val(line,1,ldi,2,ierr) IF (ierr.ne.0) THEN WRITE(6,*) '--error-- in the routine rdoutgene.' WRITE(6,*) 'Cannot read stoichiometric coefficient ' WRITE(6,*) 'at line' WRITE(6,*) line(1:60) STOP ENDIF 400 CONTINUE * error - line does not start with *, END or REAC ELSE WRITE (6,*) '--error--, in rdoutgene' WRITE (6,*) 'keyword unknown while reading :',filename WRITE (6,*) 'at line :', line(1:30) STOP ENDIF * read next reaction GOTO 20 * LABEL 30 = end of file 30 CONTINUE CLOSE(10) RETURN * error while reading 999 WRITE(6,*) '--error999--, in rdoutgene at line' WRITE(6,*) line STOP 998 WRITE(6,*) '--error998--, in rdoutgene at line' WRITE(6,*) line STOP 997 WRITE(6,*) '--error997--, in rdoutgene at line' WRITE(6,*) line STOP 996 WRITE(6,*) '--error996--, in rdoutgene at line' WRITE(6,*) line STOP END