CHARACTER*40 INFILE1,INFILE2,FILENAME CHARACTER*70 BSTRING, ASTRING(70000) LOGICAL EFLG, near(70000) real*8 M1(3,70000),M2(3),d INTEGER*4 I,J,k character*14 nres(70000),nres2 1200 FORMAT(A) write(6,*)'Read 2 .PDB files and list all pairs of atoms ' write(6,*) 'in one file within threshold distance' write(6,*) 'of atom in other file' write(6,*) 'create 2 new pdb files:' write(6,*) 'near.pdb contains all atoms in file1 within thresh' write(6,*) 'far.pdb contains all atoms in file1 outside thresh' c read first file into m1 6 WRITE(6,*) 'ENTER NAME OF 1st pdb file:' READ(5,1200) INFILE1 IF (INFILE1(:5).EQ.' ') STOP INQUIRE(FILE=INFILE1, NAME=FILENAME,EXIST=EFLG) IF (.NOT.EFLG) GOTO 6 c OPEN (UNIT=2,FILE=INFILE1,STATUS='OLD',READONLY) OPEN (UNIT=2,FILE=INFILE1,STATUS='OLD') 8 WRITE(6,*) 'ENTER NAME OF 2nd pdb file:' READ(5,1200) INFILE2 IF (INFILE2(:5).EQ.' ') STOP INQUIRE(FILE=INFILE2, NAME=FILENAME,EXIST=EFLG) IF (.NOT.EFLG) GOTO 8 c OPEN (UNIT=3,FILE=INFILE2,STATUS='OLD',READONLY) OPEN (UNIT=3,FILE=INFILE2,STATUS='OLD') write(6,*)'List atoms closer than R. R=?' read (5,*) thresh write(6,*)'Listing intermolecular contacts closer than ',thresh write(6,*) ' between ',INFILE1(:15),' and ',INFILE2(:15) k=1 c read coord 50 read(2,1200,end=85) ASTRING(k) if ((ASTRING(k)(1:5).eq.'ATOM ').or.(ASTRING(k)(1:6).eq.'HETATM')) then c write(6,*) ASTRING(k) read (ASTRING(k),51) nres(k),(m1(i,k),I=1,3) 51 format (12x,A14,4x,3d8.3,2f6.2) c write(6,*) ASTRING(k), k,nres(k),(m1(i,k),I=1,3) k=k+1 if (k.gt.70000) goto 82 endif 80 goto 50 82 write(6,*) 'truncating first file: dimensioned for <70000 atoms!' 85 read(3,1200,end=1160) BSTRING if ((BSTRING(1:6).eq.'ATOM ').or.(BSTRING(1:6).eq.'HETATM')) then read (BSTRING,51) nres2,(m2(i),I=1,3) c write(6,*) nres2,(m2(i),I=1,3) do 110 j=1,k-1 88 x=0. do 90 i=1,3 90 x=x+(m1(i,j)-m2(i))**2 d=sqrt(x) c write(6,*) j,nres(j),(m1(i,j),I=1,3), nres2,(m2(i),I=1,3),d if (d.le.thresh) then write (6,111) nres(j),nres2,d 111 format (' ',2A20,16f6.1) near(j)=(.true.) endif 110 continue endif goto 85 1160 CLOSE(UNIT=2) CLOSE(UNIT=3) OPEN (UNIT=8,FILE='near.pdb',STATUS='UNKNOWN') OPEN (UNIT=9,FILE='far.pdb',STATUS='UNKNOWN') do 1170 j=1,k if (near(j)) write(8,'(A70)')ASTRING(j) 1170 if (.not.near(j)) write(9,'(A70)')ASTRING(j) CLOSE(UNIT=8) CLOSE(UNIT=9) if (k.gt.70000) write(6,*)'***First file truncated after',k-1,' Atoms!***' END