************************************************************************ * MASTER MECHANISM - ROUTINE NAME naming * * * * PURPOSE : Creates a 6-character name for species given as * * input (chem). The routine returns the index after which * * the "new" name must be included in table of the already * * names (namlst). The codes corresponding to the various * * functional groups are returned as well, for dictionary * * update. * * * * The purpose is to create a 6-character name for every new initial * * or product species, which is not already in the dictionary. * * According to the functional groups in the specie the naming * * system is: * * 1st char - most important functional group * * 2nd char - second important functional group * * 3rd char - number of carbon atoms (modulo 10) * * 4-6th char - separate species with identical names * * * * INPUT: * * - chem : formula of the species for which a short name * * must be given * * - namlst(j) : name (lco=6 characters) of the species already * * used at position number j * * - nrec : number of species recorded * * - 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 * * * * OUTPUT: * * - iloc : index after which the "new" name must be * * included in namlst * * - name : name for the new chem * * - fgrp : code string corresponding to the various functional * * group in chem * ************************************************************************ SUBROUTINE naming(chem,namlst,nrec,nfn,namfn,chemfn, & iloc,name,fgrp) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'organic.h' INTEGER nord PARAMETER (nord=32) * input: CHARACTER(LEN=lfo) chem CHARACTER(LEN=lco) namlst(mni) INTEGER nrec INTEGER nfn CHARACTER(LEN=lco) namfn(mfn) CHARACTER(LEN=lfo) chemfn(mfn) * output INTEGER iloc CHARACTER(LEN=lco) name CHARACTER(LEN=lfl) fgrp * internal: INTEGER srh5 INTEGER nc, lfg, il INTEGER ic, ih, in, io, ir, is, ibr, ifl, icl INTEGER i, j, k, l INTEGER np, na, ng, nf, m LOGICAL lohc CHARACTER*9 hcstring CHARACTER(LEN=nord) ord DATA hcstring /'CH1234().'/ DATA ord /'0123456789FBLSMXTEPAGHNUDVWKORCY'/ * ----------- * initialize * ----------- lfg = 1 fgrp = ' ' nc = INDEX(chem,' ') - 1 * count number of atom and radical dots CALL number(chem,nc,ic,ih,in,io,ir,is,ifl,ibr,icl) * check number of carbons IF ( (ic.LT.0) .OR. (ic.GT.mca) ) THEN WRITE(6,'(a)') '--error-- in naming. Illegal species :' WRITE(6,'(a)') chem STOP ENDIF * no single-carbon molecule allowed: IF (ic .LE. 1) THEN WRITE(6,'(a)') '--error-- in naming' WRITE(6,'(a)') 'routine called with a single carbon species:' WRITE(6,'(a)') chem STOP ENDIF CALL codefg(chem,fgrp,lfg) * ---------------------------------------- * CHECK IF THE SPECIES HAS A FIXED NAME * ---------------------------------------- * if the species has an imposed name, find the position at * which the species must be inserted in the namlst table * and jump to the end (label 600) DO i=1,nfn IF (chem.eq.chemfn(i)) THEN name = namfn(i) iloc = srh5(name,namlst,nrec) IF (iloc.gt.0) THEN WRITE(6,*) '--error-- in naming. The following' WRITE(6,*) 'is given in the fixed name table' WRITE(6,*) 'but the correponding short name seems' WRITE(6,*) 'to be already used' WRITE(6,*) 'name:',name(1:6) WRITE(6,*) 'chem:',chem(1:nc) STOP ENDIF iloc= - iloc GOTO 600 ENDIF ENDDO * --------------------------------------------------- * WRITE NAME * --------------------------------------------------- * first 2 characters * ================== * decide on first two characters of NAME based on dominant * groups in fgrp - the priority is given in reverse order in 'ord' il = 0 DO i=1,nord DO j=1,lfg IF (fgrp(j:j).EQ.ord(i:i)) THEN il = il + 1 name(il:il) = fgrp(j:j) IF (il.EQ.2) GO TO 315 ENDIF ENDDO ENDDO IF (il.EQ.0) THEN WRITE(6,'(a)') '--error-- in naming. Cannot find the first ' WRITE(6,'(a)') 'character to name the following chemical :' WRITE(6,'(a)') chem(1:nc) STOP ENDIF IF( il.EQ.1) name(2:2) = '0' 315 CONTINUE * third character * ================ * write number of C's into 3rd position (only modulo 10): j = MOD(ic,10) WRITE(name(3:3),'(I1)') j io=0 IF (chem.eq.'CH3COCdH=CdHCH(O.)CO(OH)') io=1 IF (chem.eq.'CO(OH)CH(OH)COCH(OOH)CH(O.)CO(OH)') io=1 IF (io.eq.1) THEN WRITE(77,*) chem ENDIF * character 4 to 6, counter * ========================== * search through the list of already used names * find first available char for 4th position name(4:6) = '000' iloc = srh5(name,namlst,nrec) IF (io.eq.1) THEN WRITE(77,*) name,' ',iloc DO j=iloc-10,iloc+100 IF(j.GT.0) WRITE(77,*) j,' ',namlst(j) ENDDO ENDIF * if iloc <= 0 then free slot located at iloc = - iloc + 1 and exit. * However must check that the name does not already exist for another * molecule in fixedname.dat. If exist then jump to get the next number. * The XYZ000 name may also not exist in the used list but the first 3 * letter XYZ may already be used (XYZ000 simply not used since reserved * for a given species). So check that 'XYZ'' is known in the used list. IF (iloc.LE.0) THEN iloc = -iloc IF (name(1:3).eq.namlst(iloc+1)(1:3)) GOTO 500 DO l=1,nfn IF (name.eq.namfn(l)) THEN i=1 j=1 k=1 GOTO 370 ENDIF ENDDO GOTO 600 ENDIF * loop over the species in namlst. search reccorded name having * the same first 3 character. Find the last position occupied. 500 CONTINUE iloc=iloc+1 DO k=iloc,nrec+1 IF (namlst(k)(1:3).ne.name(1:3)) THEN iloc=k GOTO 360 ENDIF ENDDO 360 CONTINUE iloc=iloc-1 IF (io.eq.1) THEN WRITE(77,*) 'iloc=',iloc ENDIF * find the indexes IF (namlst(iloc)(1:1).eq.' ') THEN IF (name(4:6).eq.'000') THEN i=1 j=1 k=1 ENDIF ELSE i=INDEX(alfa,namlst(iloc)(4:4)) j=INDEX(alfa,namlst(iloc)(5:5)) k=INDEX(alfa,namlst(iloc)(6:6)) ENDIF IF (io.eq.1) THEN WRITE(77,*) 'i=',i WRITE(77,*) 'j=',j WRITE(77,*) 'k=',k ENDIF IF ( (i.eq.0).OR.(j.eq.0).OR.(k.eq.0) ) THEN WRITE(6,*) '--error-- in naming. One of the character ' WRITE(6,*) 'for the name in namlst is not allowed ' WRITE(6,*) 'name in the list:',namlst(iloc) WRITE(6,*) 'name search:',name STOP ENDIF * name the species. 370 CONTINUE k=k+1 IF (k.gt.nalfa) THEN k=2 j=j+1 ENDIF IF (j.gt.nalfa) THEN j=1 i=i+1 ENDIF IF (i.gt.nalfa) THEN WRITE(6,*) '--error-- in naming. all the slot to name' WRITE(6,*) 'are occupied' WRITE(6,*) 'name:',name WRITE(6,*) 'chem:',chem(1:nc) STOP ENDIF name(4:4)=alfa(i:i) name(5:5)=alfa(j:j) name(6:6)=alfa(k:k) * check that name does not already exist for another molecule in * fixedname.dat. If yes, then take the next in the list DO l=1,nfn IF (name.eq.namfn(l)) GOTO 370 ENDDO 600 CONTINUE RETURN END