************************************************************************ * MASTER MECHANISM - ROUTINE NAME in1chm * * * * PURPOSE: - handle the case of starting from a species * * * * The subroutine checks the species, gives it a name (if not already * * in the dictionary), updates the dictionary and puts the species at * * the beginning of the stack (i.e. in holdvoc(1)). Stack variables are * * updated. * * * * * * INPUT: * * - chem : formula of the primary species that must be added * * at the first position of the stack * * - nfn : total nb. of species having a fixed name * * - namfn(i) : table of the fixed names (6 character) * * - chemfn(i) : formula corresponding to the ith species having a * * fixed name * * * * INPUT/OUTPUT: * * - nrec : number of species recorded * * - 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 (must be 1 at * * output) * * - holdvoc(i) : list of the VOC in the stack * * - nhldrad : number of radicals in the stack * * - holdvoc(i) : list of the radicals in the stack (see information * * above) * * - stabl : gives the number of generation that was necessary * * to produce the species chem (set to 0 in in1chm) * * - level : gives the number of intermediates (including * * radical) that was necessary to produce the * * species chem (set to 0 in in1chm) * * * ************************************************************************ SUBROUTINE in1chm(chem,nrec,nrectot, & nfn,namfn,chemfn,nspsp,dictsp, & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl) IMPLICIT NONE INCLUDE 'general.h' * input CHARACTER(LEN=lfo) chem * i/o INTEGER nrec,nrectot INTEGER nfn CHARACTER(LEN=lco) namfn(mfn) CHARACTER(LEN=lfo) chemfn(mfn) INTEGER nspsp CHARACTER(LEN=ldi) dictsp(mfn) REAL dbrch(mni) CHARACTER(LEN=ldi) dict(mni) CHARACTER(LEN=lco) namlst(mni) CHARACTER(LEN=lst) holdvoc(mlv) INTEGER nhldvoc INTEGER nhldrad CHARACTER(LEN=lst) holdrad(mra) INTEGER level INTEGER stabl * local CHARACTER(LEN=lco) name INTEGER i,nca, nc, dicptr, namptr INTEGER srch, srch_special, srh5, cnum,onum, ipos REAL brch CHARACTER(LEN=lfl) fgrp * initialise name = ' ' nc = INDEX(chem,' ') - 1 * IF THE SPECIES IS A SPECIAL SPECIES. * ------------------------------------ IF (chem(1:1).eq.'#') THEN * -------------------------------------------------------------------- * search if chem already exists in the dictionary. Special species * are put in C1 dictionary. If new species (dicptr<0) put it in the * dictionary arrays and initialize the stack. If not new, then just * return * -------------------------------------------------------------------- brch = 1. nca=1 dicptr = srch(nrec,chem,dict) * already recorded IF (dicptr.GT.0) THEN level = -1 WRITE(6,*) & 'cheminput found in dictionary: ',chem(1:50) RETURN ENDIF * search the name ipos=0 DO i=1,nspsp IF (dictsp(i)(10:130).eq.chem) THEN ipos=i name=dictsp(i)(1:6) namptr = srh5(name,namlst,nrec) fgrp=dictsp(i)(131:) namptr=-namptr GOTO 100 ENDIF ENDDO IF (ipos.eq.0) STOP '-error- species not found in in1chm' ENDIF * IF THE SPECIES IS A REGULAR SPECIES * ----------------------------------- * get the number of carbons in species - must be greater than 1 nca = cnum(chem,nc)+onum(chem,nc) IF (nca.LE.1) THEN WRITE(6,*) '--error--, in in1chem' WRITE(6,*) 'routine called for species with < 2 carbons' WRITE(6,*) chem STOP ENDIF * standardize chem brch = 1. CALL stdchm(chem) * -------------------------------------------------------------------- * search if chem already exists in the dictionary. If new (dicptr<0) * then give it a name, put it in the dictionary arrays and initialize * the stack. If not new, then just return * -------------------------------------------------------------------- dicptr = srch(nrec,chem,dict) IF (dicptr.GT.0) THEN level = -1 WRITE(6,*) & 'cheminput found in dictionary: ',chem(1:50) RETURN ENDIF * get the short name for the species (pname) and position after which * it must be added in the namlst table (namptr) CALL naming(chem,namlst,nrec,nfn,namfn,chemfn, & namptr,name,fgrp) * ================================================================ * ENTRY POINT TO UPDATE STACK AND DICTIONARY ARRAY (SPECIES MAY * COME FROM THE SPECIAL DICTIONARY '#') * ================================================================ 100 CONTINUE * raise the counter nrectot = nrectot + 1 IF (nrectot.GE.mni) then WRITE(6,*) '--error--, in in1chem' WRITE(6,*) 'number of species in the dictionnary' WRITE(6,*) 'exceeds the size of the table (mni)' STOP ENDIF nrec = nrec + 1 IF (nrec.GT.mni) THEN WRITE (6,*) 'Warning from in1chem' WRITE (6,*) 'more species with ,',nca,' C' WRITE (6,*) 'than mnic' STOP ENDIF * add new name and raise the name array namptr = namptr + 1 DO i=nrec,namptr,-1 namlst(i+1) = namlst(i) ENDDO namlst(namptr) = name * raise upper part of dictionary arrays and branching array * insert new line for the new species dicptr = ABS(dicptr) + 1 DO i=nrec,dicptr,-1 dict(i+1) = dict(i) dbrch(i+1) = dbrch(i) ENDDO WRITE(dict(dicptr),'(a6,3x,a120,2x,a15,a3)') & name, chem, fgrp, '000' dbrch(dicptr) = brch * load species information for future reactions in the stack. * loader increments stabl and level, so set to zero stabl = 0 level = 0 CALL loader(dicptr,chem,name, & level,stabl,nhldvoc,holdvoc,nhldrad,holdrad) WRITE(6,*)'::cheminput added to dictionary::',chem(1:50) RETURN END