SUBROUTINE GET_PDB_DICT(MDOC,LIST,FILE_PDB_D,IERR) C ----------------------------------------------- INTEGER*4 MDOC,IERR CHARACTER FILE_PDB_D*(*),LIST*1 C ----------------------------------------------- INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C ----------------------------------- INTEGER*4 ICEND,JEND,IHNAME CHARACTER STR*80,REC*6 C --- INTEGER*4 M,IUN,IEND CHARACTER LINE*80,PATH*1,EXT*3 C ----------------------------------- IERR=0 IEND=0 C --- C open file of PDB_DICT EXT=' ' PATH=' ' IF(FILE_PDB_D(1:1).EQ.' ') THEN CALL MSGERR(MDOC,' ERROR: can''t open PDB_DICT_file') IERR=1 RETURN ENDIF IUN=14 M=99 CALL OPENFR(IUN,M,PATH,FILE_PDB_D,EXT,IERR) IF(IERR.NE.0) THEN CALL MSGERR(MDOC,' ERROR: can''t open PDB_DICT_file') RETURN ENDIF C --- ICEND = 0 IHNAME = 0 HENT_ID = ' ' HENT_FORMUL = '.' HENT_NAME = '.' NA_HENT = 0 CALL GETLINE(IUN,MDOC,STR,IERR,JEND) ICEND=JEND IF(IERR.NE.0.OR.JEND.NE.0) THEN IEND=JEND CLOSE=(IUN) RETURN ENDIF REC = ' ' C ----- 100 CONTINUE LINE=STR IEND=ICEND IF(IEND.NE.0) THEN IF(NA_HENT.GT.0.AND.HENT_ID.NE.' ') THEN CALL CP_CONN_L1(MDOC,LIST,IERR) IF(IERR.NE.0) RETURN ENDIF CLOSE(IUN) RETURN ENDIF CALL GETLINE(IUN,MDOC,STR,IERR,JEND) IF(IERR.NE.0) THEN CLOSE(IUN) RETURN ENDIF ICEND=JEND IF(LINE(1:6).EQ.'HET ') THEN CALL RDHET_D(LINE) GO TO 100 ELSE IF(LINE(1:6).EQ.'FORMUL') THEN CALL RDFORMUL_D(LINE) GO TO 100 ELSE IF(LINE(1:6).EQ.'HETNAM') THEN IF(IHNAME.NE.0) GO TO 100 CALL RDHNAM_D(LINE) IHNAME=1 GO TO 100 ELSE IF(LINE(1:6).EQ.'RESIDU') THEN IF(NA_HENT.GT.0.AND.HENT_ID.NE.' ') THEN CALL CP_CONN_L1(MDOC,LIST,IERR) IF(IERR.NE.0) RETURN ENDIF IHNAME = 0 HENT_ID = ' ' HENT_FORMUL = '.' HENT_NAME = '.' NA_HENT = 0 CALL RESID_PDB(LINE) GO TO 100 ELSE IF(LINE(1:6).EQ.'END ') THEN REC='END ' GO TO 100 ELSE IF(LINE(1:6).EQ.'CONECT') THEN CALL RDCONECT_D(MDOC,LIST,LINE,IERR) REC='CONECT' GO TO 100 ELSE GO TO 100 ENDIF GO TO 100 C ----------------------------------- END SUBROUTINE RESID_PDB(LINE) C ------------------------------------------------------- C -P- RDMODEL - reads record MODEL from PDB_file. C -S- C ------------------------------------------------------- CHARACTER LINE*(*) C ****** C ------------------------------------------------------ INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- C ----------------------------------- CHARACTER FRMT*80,MON*3 DATA FRMT/'(10X,A3,3X,I4)'/ C ------------------------------------ READ(LINE,FRMT) MON,NA IF(MON(1:1).EQ.' ') THEN MON=MON(2:3)//' ' IF(MON(1:1).EQ.' ') MON=MON(2:3)//' ' ENDIF HENT_ID = MON NAR_HENT = NA RETURN END SUBROUTINE RDHET_D(LINE) C ------------------------------------------------------- C -P- RDHET - reads record HET from PDB_file. C -S- C ------------------------------------------------------- CHARACTER LINE*(*) C ----------------------------------- INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- C ----------------------------------- CHARACTER FRMT*80,MON*3 DATA FRMT/'(7X,A3,10X,I5)'/ C ------------------------------------ C READ(LINE,FRMT) MON,NA RETURN END SUBROUTINE RDHNAM_D(LINE) C ------------------------------------------------------- CHARACTER LINE*(*) C ----------------------------------- INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- C ----------------------------------- CHARACTER FRMT*80,MON*3,NAME*80 DATA FRMT/'(11X,A3,1X,A40)'/ C ------------------------------------ READ(LINE,FRMT) MON,NAME CALL LENSTR_BL(NAME,LEN) IF(LEN.GT.0) THEN c LN=0 c IFIRST=0 c DO I=1,LEN c IF(NAME(I:I).NE.' '.AND.IFIRST.EQ.0) THEN c IFIRST=1 c ENDIF c IF(NAME(I:I).NE.' '.OR.IFIRST.EQ.1) THEN c LN=LN+1 c NAME(LN:LN)=NAME(I:I) c ENDIF c ENDDO c LEN=LN DO I=1,LEN C IF(NAME(I:I).EQ.' ') NAME(I:I)='_' IF(NAME(I:I).EQ.'''') NAME(I:I)='*' ENDDO IF(NAME(1:1).EQ.'_') NAME(1:1)='-' ELSE NAME='.' LEN=1 ENDIF IF(LEN.GT.40) LEN=40 HENT_NAME = NAME(1:LEN) RETURN END SUBROUTINE RDFORMUL_D(LINE) C ------------------------------------------------------- C -P- RDFORMUL - reads record FORMUL from PDB_file. C -S- C ------------------------------------------------------- CHARACTER LINE*(*) C ----------------------------------- INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- C ----------------------------------- CHARACTER FRMT*80,MON*3,FORMUL*40 DATA FRMT/'(12X,A3,4X,A40)'/ C ------------------------------------ READ(LINE,FRMT) MON,FORMUL C IF(MON(1:1).EQ.' ') THEN C MON=MON(2:3)//' ' C IF(MON(1:1).EQ.' ') MON=MON(2:3)//' ' C ENDIF CALL LENSTR_BL(FORMUL,LEN) IF(LEN.GT.0) THEN DO I=1,LEN IF(FORMUL(I:I).EQ.' ') FORMUL(I:I)='_' IF(FORMUL(I:I).EQ.'''') FORMUL(I:I)='*' ENDDO ELSE FORMUL='.' LEN=1 ENDIF IF(LEN.GT.40) LEN=40 HENT_FORMUL = FORMUL(1:LEN) RETURN END SUBROUTINE RDCONECT_D(MDOC,LIST,LINE,IERR) C ----------------------------------------------- INTEGER*4 MDOC,IERR CHARACTER LINE*(*),LIST*1 C ----------------------------------- INCLUDE 'atom_com.fh' C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- CHARACTER STR*80,ATOM*4,ACONN(8)*4 CHARACTER FRMT*80 DATA FRMT/ *'(11X,A4,1X,I4,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4,1X,A4)'/ C ------------------------------------ IERR=0 READ(LINE,FRMT) ATOM,N,ACONN(1),ACONN(2),ACONN(3),ACONN(4) * ,ACONN(5),ACONN(6),ACONN(7),ACONN(8) IF(NAR_HENT.GT.1.AND.N.EQ.0) RETURN IF(NA_HENT.GE.MAXATOM) THEN WRITE(STR * ,'('' ERROR: number of CONECT records of PDB DICT file >'' * ,I6)') MAXATOM CALL MSGERR(MDOC,STR) CALL MSGERR(MDOC, * ' Change parameter MAXATOM in "atom_com.fh"') IERR=1 RETURN ENDIF NA_HENT = NA_HENT + 1 CONA_PDB (NA_HENT) = ATOM NCONN_PDB(NA_HENT) = N IF(N.LE.0) RETURN IF(N.GT.8) N=8 I1 = 1 DO I =1,N I2=I1+3 CONN_PDB(NA_HENT)(I1:I2) = ACONN(I) I1 = I1+4 IF(LIST.EQ.'T') THEN WRITE(STR,'(''read:'',2i4,''<'',A4''>'','' <'',A32,''>'')') * NA_HENT,NCONN_PDB(NA_HENT),CONA_PDB(NA_HENT),CONN_PDB(NA_HENT) CALL MSGDOC(MDOC,STR) ENDIF ENDDO C --- RETURN END SUBROUTINE CP_CONN_L1(MDOC,LIST,IERR) C ----------------------------------------- C ----------------------------------------- INTEGER*4 MDOC,IERR C --- INCLUDE 'lib_com.fh' INCLUDE 'atom_com.fh' C ****** C ----------------------------------- COMMON /PDB_HENT_DICT/ NCONN_PDB,ICONA_PDB,ICONN_PDB,NA_HENT * ,NAR_HENT,CONA_PDB,CONN_PDB,SYMB_HENT * ,HENT_NAME,HENT_FORMUL,HENT_ID INTEGER*4 NCONN_PDB (MAXATOM) INTEGER*4 ICONA_PDB (MAXATOM) INTEGER*4 ICONN_PDB(8,MAXATOM) CHARACTER CONA_PDB (MAXATOM)*4 CHARACTER CONN_PDB (MAXATOM)*32 CHARACTER SYMB_HENT (MAXATOM)*4 INTEGER*4 NA_HENT,NAR_HENT CHARACTER HENT_ID *3 CHARACTER HENT_NAME *40 CHARACTER HENT_FORMUL *40 C --- CHARACTER LINE*80,MON*3,RES*3,ASYMB*4,CTYPE*4,ATOM*4 CHARACTER NAME*80,MODE*4,MOD*1,LIST*1,CH4*4 C -------------------------------- IERR=0 MON=HENT_ID IF(LML_NMON.LE.0) THEN ELSE DO L=1,LML_NMON IF(MON.EQ.LML_MNAME(L)) THEN WRITE(LINE, *'('' WARNING : monomer:'',A3,'' - is found in the library .'')') * MON CALL MSGERR(MDOC,LINE) WRITE(LINE, *'('' program will not create new description of *f monomer'')') CALL MSGERR(MDOC,LINE) LML_FUSE (L)='N' RETURN ENDIF ENDDO ENDIF C --- IF(LML_NMON.GE.MAXMLIST) THEN WRITE(LINE,'('' ERR: number of monomers >'' * ,I6,'' /lib. limit/'')') MAXMLIST CALL MSGERR(MDOC,LINE) CALL MSGERR(MDOC, * ' Change parameter MAXMLIST in "lib_com.fh"') IERR=1 RETURN ENDIF L1L_MNAME = MON L1L_NAME = HENT_NAME L1L_MNAME2= MON L1L_CODE1 = 'x' L1L_TYPE = 'non-polymer' L1L_MODE = '.' L1L_FORM = HENT_FORMUL L1L_FUSE = '?' L1L_PRSNT = '?' L1L_HFLAG = '.' L1L_NATM = NA_HENT L1L_NHATM = 0 L1A_NATOM = 0 L1A_NHATOM= 0 L1N_NCONN = 0 L1B_NBOND = 0 L1G_NANGL = 0 L1T_NTORS = 0 L1C_NCHIR = 0 L1P_NPLAN = 0 DO I=1,NA_HENT IF(L1A_NATOM.GE.MAX1ATM) THEN WRITE(LINE,'( * '' ERROR: in "LPUT_NEW", number of atoms in monomer '',A3, * '' >'',I6)') MON,MAX1ATM CALL MSGERR(MDOC,LINE) CALL MSGERR(MDOC, * ' Change parameter MAX1ATM in "lib_com.fh"') IERR=1 RETURN ENDIF L1A_NATOM = L1A_NATOM+1 L1A_COOR_FLAG(L1A_NATOM) = 'N' L1A_CHARG(L1A_NATOM) = 0.0 L1A_X (L1A_NATOM) = 0.0 L1A_Y (L1A_NATOM) = 0.0 L1A_Z (L1A_NATOM) = 0.0 L1A_INEW (L1A_NATOM) = L1A_NATOM L1A_IOLD (L1A_NATOM) = L1A_NATOM L1A_ICR (L1A_NATOM) = 0 L1A_NDIST(L1A_NATOM) = 0 L1A_IBACK(L1A_NATOM) = 0 L1A_IFORW(L1A_NATOM) = 0 L1A_BACK (L1A_NATOM) = '.' L1A_TYPE (L1A_NATOM) = '.' L1A_FORW (L1A_NATOM) = '.' RES = MON ATOM = CONA_PDB(I) IF(LIST.EQ.'T') THEN CH4 = ATOM ENDIF CALL CORR_NAME(ATOM,RES,ASYMB,CTYPE) IF(LIST.EQ.'T') THEN WRITE(LINE, * '(''name:''a4,'': corr_name:'',a4,'': symb:'',a4,'':'')') * CH4,ATOM,ASYMB CALL MSGDOC(MDOC,LINE) ENDIF C --- IF(L1A_NATOM.GT.1) THEN DO J=1,L1A_NATOM-1 IF(ATOM.EQ.L1A_ANAME(J)) THEN WRITE(LINE,'( * ''WARNING: "'',A3,''" : dublicated atom_name "'',A4,''"'')') * MON,ATOM CALL MSGERR(MDOC,LINE) ATOM(4:4)='?' IF(ATOM(2:2).EQ.' ') ATOM(2:2)='_' IF(ATOM(3:3).EQ.' ') ATOM(3:3)='_' WRITE(LINE,'( * '' new atom_name "'',A4,''"'')') * ATOM CALL MSGERR(MDOC,LINE) ENDIF ENDDO ENDIF C --- L1A_ANAME(L1A_NATOM) = ATOM L1A_SYMB (L1A_NATOM) = ASYMB L1A_CHEM (L1A_NATOM) = ASYMB L1A_ATYPE(L1A_NATOM) = '.' IF(L1A_CHEM(L1A_NATOM)(1:2).NE.'H '.AND. * L1A_CHEM(L1A_NATOM)(1:2).NE.'D ' ) * L1A_NHATOM=L1A_NHATOM + 1 DO J=1,MAX1BRN L1A_CONN (J,L1A_NATOM) = 0 L1A_LENCON (J,L1A_NATOM) = 0 ENDDO DO J=1,MAX1EXT L1A_IEXTR (J,L1A_NATOM) = 0 ENDDO ENDDO C ---- DO I=1,NA_HENT IF(NCONN_PDB(I).GT.0) THEN I1=1 DO J=1,NCONN_PDB(I) I2=I1+3 ATOM=CONN_PDB(I)(I1:I2) DO K=1,NA_HENT IF(ATOM.EQ.CONA_PDB(K).AND.I.LT.K) THEN IF(L1N_NCONN.GE.MAX1CONN) THEN WRITE(LINE,'( * '' ERROR: number of connections in monomer '',A3,'' >'',I6)') * MON,MAX1CONN CALL MSGERR(MDOC,LINE) CALL MSGERR(MDOC, * ' Change parameter MAX1CONN in "lib_com.fh"') IERR=1 RETURN ENDIF L1N_NCONN = L1N_NCONN + 1 L1N_I1ATM(L1N_NCONN) = I L1N_I2ATM(L1N_NCONN) = K L1N_1ATM(L1N_NCONN) = L1A_ANAME(I) L1N_2ATM(L1N_NCONN) = L1A_ANAME(K) L1N_TYPE(L1N_NCONN) = '.' ENDIF ENDDO I1=I1+4 ENDDO ENDIF ENDDO L1L_NHATM = L1A_NHATOM C ----------------------------- MODE = 'CONN' VANGLE = 0.0 NAME = 'pdb_dict' CALL CREAT_NEW_D(MDOC,MODE,NAME,VANGLE,IERR) IF(IERR.NE.0) RETURN L1L_PRSNT = 'M' C L1L_PRSNT = 'Y' L1L_FUSE = 'C' L1N_NCONN = 0 L1G_NANGL = 0 L1T_NTORS = 0 L1C_NCHIR = 0 L1P_NPLAN = 0 CALL CPL_MLIB(MDOC,IERR) IF(IERR.NE.0) RETURN RETURN END C SUBROUTINE CREAT_NEW_D(MDOC,MODE,NAME,VANGLE,IERR) C ----------------------------------------- C -P- CREAT_NEW - C -- MODE: 'COOR' -- C input: C L1L_MNAME C L1L_CODE1 C L1L_TYPE C L1L_NAME C L1A_NATOM C L1A_COOR_FLAG() = 'Y' C L1A_X () C L1A_Y () C L1A_Z () C L1A_ANAME () - atom's name C L1A_SYMB () - atom's symbol - 'C ','N ','O ','H ', C 'FE ','P ','S ','CL ',... C -- MODE: 'CONN' -- C input: C C C C ------ C input: C L1L_MNAME C L1L_CODE1 C L1L_TYPE C L1L_NAME C L1A_NATOM C L1A_COOR_FLAG() = 'Y' or 'N' C L1A_X () C L1A_Y () C L1A_Z () C L1A_CHEM () C L1A_BACK () C L1A_TYPE () C L1A_FORW () C L1A_ANAME () - atom's name C L1A_SYMB () - atom's symbol - 'C ','N ','O ','H ', C 'FE ','P ','S ','CL ',... C L1N_NCONN C L1N_1ATM () C L1N_2ATM () C L1N_TYPE () C -S- C ----------------------------------------- INTEGER*4 MDOC,IERR CHARACTER MODE*4,NAME*(*) C --- INCLUDE 'lib_com.fh' C ****** REAL DLIM(4) INTEGER*4 IJA(3),ICH4 CHARACTER LIST*1,HMODE*1 CHARACTER CIATOM*1,CJATOM*1,LINE*80,CH2*2,CH4*4,MON*3 CHARACTER ASYMB*4,CTYPE*4,FLAG*1,MOD*1 EQUIVALENCE (ICH4,CH4) DATA DLIM/ 1.2, 1.7, 2.4, 3.5 / C -------------------------------- M=-ABS(MDOC)-1 IF(L1A_NATOM.LE.0) THEN WRITE(LINE,'('' ERROR: number of atoms in new monomer '',A3, * '' = '',I6)') L1L_MNAME,L1A_NATOM CALL MSGERR(MDOC,LINE) IERR=1 RETURN ENDIF NA = L1A_NATOM MON = L1L_MNAME IF(MODE.NE.'COOR'.AND.MODE.NE.'CONN') GO TO 300 L1A_NHATOM = 0 IF(MODE.EQ.'COOR') L1N_NCONN = 0 C --- IF(NA.GT.1) THEN DO I=1,NA-1 DO J=I+1,NA IF(L1A_ANAME(I).EQ.L1A_ANAME(J)) THEN WRITE(LINE,'( * ''WARNING: "'',A3,''" : dublicated atom_name : "'',A4,''"'')') * MON,L1A_ANAME(I) CALL MSGERR(MDOC,LINE) ENDIF ENDDO ENDDO ENDIF C --- L1B_NBOND = 0 L1C_NCHIR = 0 L1P_NPLAN = 0 L1T_NTORS = 0 L1G_NANGL = 0 DO I=1,NA L1A_CHARG(I) = 0.0 L1A_INEW (I) = I L1A_IOLD (I) = I L1A_ICHEM(I) = 0 L1A_ICR (I) = 0 L1A_NDIST(I) = 0 L1A_IBACK(I) = 0 L1A_IFORW(I) = 0 L1A_BACK (I) = '.' L1A_TYPE (I) = '.' L1A_FORW (I) = '.' L1A_CHEM (I) = L1A_SYMB(I) DO J=1,MAX1BRN L1A_CONN (J,I) = 0 L1A_LENCON (J,I) = 0 ENDDO DO J=1,MAX1EXT L1A_TEXTR (J,I) = 0 L1A_IEXTR (J,I) = 0 ENDDO ASYMB = L1A_SYMB(I) IF(ASYMB(1:2).EQ.'C '.OR.ASYMB(1:2).EQ.'N '.OR. * ASYMB(1:2).EQ.'O '.OR.ASYMB(1:2).EQ.'B '.OR. * ASYMB(1:2).EQ.'F '.OR.ASYMB(1:2).EQ.'LI' ) THEN CTYPE='C ' ELSE IF(ASYMB(1:2).EQ.'H '.OR.ASYMB(1:2).EQ.'D ') THEN CTYPE='H ' L1A_NHATOM = L1A_NHATOM + 1 ELSE CTYPE='$ ' ENDIF L1A_ATYPE(I)=CTYPE ENDDO C --- I_LAST = 1 I_FIRST= 1 IF(NA.LE.1) THEN L1A_BACK(1)='.' L1A_FORW(1)='END' GO TO 300 ENDIF DO IA=1,NA-1 CIATOM=L1A_ATYPE(IA) DO JA=IA+1,NA CJATOM=L1A_ATYPE(JA) IF(CIATOM.EQ.'H'.AND.CJATOM.EQ.'H') THEN IC=0 ELSE IF(CIATOM.EQ.'H'.OR.CJATOM.EQ.'H') THEN IC=1 ELSE IF(CIATOM.EQ.'C'.AND.CJATOM.EQ.'C') THEN IC=2 ELSE IF(CIATOM.EQ.'$'.AND.CJATOM.EQ.'$') THEN IC=4 ELSE IC=3 ENDIF IF(IC.GT.0) THEN DIST=0.0 FLAG='N' IF(MODE.EQ.'CONN') THEN IF(L1N_NCONN.GT.0) THEN DO ICN=1,L1N_NCONN IF((L1N_I1ATM(ICN).EQ.IA.AND. * L1N_I2ATM(ICN).EQ.JA ).OR. * (L1N_I1ATM(ICN).EQ.JA.AND. * L1N_I2ATM(ICN).EQ.IA )) THEN FLAG='Y' GO TO 500 ENDIF ENDDO ENDIF 500 CONTINUE ENDIF IF((DIST.LE.DLIM(IC).AND.DIST.GT.0.001) * .OR.FLAG.EQ.'Y') THEN IF(L1B_NBOND.GE.MAX1BND) THEN WRITE(LINE * ,'('' ERROR: number of bonds of new monomer '' * ,A3,'' >'',I6)') * L1L_MNAME,MAX1BND CALL MSGERR(MDOC,LINE) CALL MSGERR(MDOC, * ' Change parameter MAX1BND in "lib_com.fh"') IERR=1 RETURN ENDIF IF(L1A_NDIST(IA).LT.MAX1BRN) THEN L1A_NDIST(IA) = L1A_NDIST(IA) + 1 L1A_CONN(L1A_NDIST(IA),IA) = JA IF(L1A_ATYPE(JA).EQ.'H') THEN L1A_LENCON(1,IA)=L1A_LENCON(1,IA)+1 ENDIF ENDIF IF(L1A_NDIST(JA).LT.MAX1BRN) THEN L1A_NDIST(JA) = L1A_NDIST(JA) + 1 L1A_CONN(L1A_NDIST(JA),JA) = IA IF(L1A_ATYPE(IA).EQ.'H') THEN L1A_LENCON(1,JA)=L1A_LENCON(1,JA)+1 ENDIF ENDIF L1B_NBOND = L1B_NBOND+1 L1B_I1ATM (L1B_NBOND) = IA L1B_1ATM (L1B_NBOND) = L1A_ANAME(IA) L1B_I2ATM (L1B_NBOND) = JA L1B_2ATM (L1B_NBOND) = L1A_ANAME(JA) L1B_VOBS (L1B_NBOND) = DIST L1B_TYPE (L1B_NBOND) = '.' ENDIF ENDIF ENDDO ENDDO DO IA=1,NA NDI = L1A_NDIST(IA) ASYMB = L1A_SYMB (IA) IF(ASYMB(1:2).EQ.'C '.OR.ASYMB(1:2).EQ.'N ') THEN IF(NDI.EQ.3) L1A_ICHEM(IA)= 1 IF(NDI.EQ.4) L1A_ICHEM(IA)= -1 ENDIF L1A_NEXTR(IA) = L1A_NDIST(IA) ENDDO CALL RING(MDOC,NRING,IERR) HMODE = 'N' IF(L1A_NHATOM.GT.0) HMODE = 'Y' LIST = ' ' cd CALL CHECK_CHEM_DD(MDOC,LIST,MODE,HMODE,IERR) DO I=1,NA ASYMB = L1A_SYMB(I) IF(ASYMB(1:2).EQ.'H '.OR.ASYMB(1:2).EQ.'D ') THEN IF(L1B_NBOND.GT.0) THEN DO J=1,L1B_NBOND IB=0 IF(I.EQ.L1B_I1ATM(J)) THEN IB=L1B_I2ATM(J) ELSE IF(I.EQ.L1B_I2ATM(J)) THEN IB=L1B_I1ATM(J) ENDIF IF(IB.GT.0) THEN CH4=L1A_CHEM(IB) IF(CH4.EQ.'CR15'.OR.CH4.EQ.'NR15'.OR. * CH4.EQ.'CR16'.OR.CH4.EQ.'NR16' ) * CH4(3:3)=CH4(4:4) L1A_CHEM(I)='H'//CH4(1:3) ENDIF ENDDO ENDIF ENDIF ENDDO C --- 300 CONTINUE C --- NH=0 DO I=1,L1A_NATOM ASYMB = L1A_SYMB(I) IF(ASYMB(1:2).NE.'H '.AND.ASYMB(1:2).NE.'D ') THEN NH=NH+1 ENDIF ENDDO L1A_NHATOM = NH L1L_NATM = L1A_NATOM L1L_NHATM = L1A_NHATOM L1L_FUSE = 'C' RETURN END