CHARACTER*40 INFILE1,INFILE2,FILENAME
	CHARACTER*70 ASTRING
	LOGICAL EFLG
	real*8 M1(3,7000),M2(3),d
	INTEGER*4 I,J,k
	character*14 nres(7000),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,*) 'ignoring y component for arbit origin in polar sg'


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         
c50	read(2,51,end=85) nres(k),(m1(i,k),I=1,3)
50	read(2,1200,end=85) ASTRING
	if ((ASTRING(1:6).eq.'ATOM  ').or.(ASTRING(1:6).eq.'HETATM')) then
c	write(6,*) ASTRING
	read (ASTRING,51) nres(k),(m1(i,k),I=1,3)
c51 	format (30x,3d8.3,2f6.2)
51      format (12x,A14,4x,3d8.3,2f6.2)
c	write(6,*) k,nres(k),(m1(i,k),I=1,3)
	k=k+1
	if (k.gt.7000) write(6,*) 'dimensioned for <7000 atoms in first file!'
	if (k.gt.7000) goto 85
	endif
80	goto 50


c123456789012345678901234567890
c            123456789012345678901234567890
cATOM    450  CA  ALA J  61      28.433 161.994  41.553  1.00 99.97          

	
c85	read(3,1200,end=1160) nres2,(m2(i),I=1,3)
85	read(3,1200,end=1160)  ASTRING
	if ((ASTRING(1:6).eq.'ATOM  ').or.(ASTRING(1:6).eq.'HETATM')) then
	read (ASTRING,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.
c	for i=1 to 3 STEP 2 to skip i=2=y component.
	do 90 i=1,3,2
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
110	if (d.le.thresh) write (6,111) nres(j),nres2,d
111	format (' ',2A20,16f6.1)
	endif
	goto 85

1160	CLOSE(UNIT=2)
	if (k.gt.7000) write(6,*)'***First file truncated after',k-1,' Atoms!***'
	END