CHARACTER*40 INFILE1,INFILE2,FILENAME
	CHARACTER*70 ASTRING
	LOGICAL EFLG
	real*8 M1(3),M2(3),d
	INTEGER*4 I,J,k
	character*14 nres(7000),nres2

1200	FORMAT(A)
c	write(6,*)'Read 2 .PDB files and list all pairs of atoms '
c	write(6,*) 'in one file within threshold distance'
c	write(6,*) 'of atom in other file'


c 	read first file into m1
c6	WRITE(6,*) 'ENTER NAME OF 1st pdb file:'
	READ(5,1200) INFILE1
	IF (INFILE1(:5).EQ.'     ') STOP
	  INQUIRE(FILE=INFILE1, NAME=FILENAME,EXIST=EFLG)
c	  IF (.NOT.EFLG) GOTO 6
        OPEN (UNIT=2,FILE=INFILE1,STATUS='OLD',READONLY)
c8	WRITE(6,*) 'ENTER NAME OF 2nd pdb file:'
	READ(5,1200) INFILE2
	IF (INFILE2(:5).EQ.'     ') STOP
	  INQUIRE(FILE=INFILE2, NAME=FILENAME,EXIST=EFLG)
c	  IF (.NOT.EFLG) GOTO 8
        OPEN (UNIT=3,FILE=INFILE2,STATUS='OLD',READONLY)

c	write(6,*)'List atoms closer than R. R=?'
	read (5,*) thresh
c	write(6,*)'Listing intermolecular contacts closer than ',thresh
c	write(6,*) '   between ',INFILE1(:15),' and ',INFILE2(:15)

c 	read coord         
50	read(2,1200,end=85) ASTRING
	if ((ASTRING(1:6).ne.'ATOM  ').and.(ASTRING(1:6).ne.'HETATM')) 
     .  goto 50
c 	write(6,*) ASTRING
	DECODE(70,51,ASTRING) nres(k),(m1(i),I=1,3)
51      format (12x,A14,4x,3d8.3,2f6.2)
c 	write(6,*) k,nres(k),(m1(i),I=1,3)



85	read(3,1200,end=1160)  ASTRING
	if ((ASTRING(1:6).eq.'ATOM  ').or.(ASTRING(1:6).eq.'HETATM')) then
	DECODE(70,51,ASTRING) nres2,(m2(i),I=1,3)
c	write(6,*) nres2,(m2(i),I=1,3)




88	x=0.
	do 90 i=1,3
90	x=x+(m1(i)-m2(i))**2
	d=sqrt(x)
c	write(6,*) j,nres(j),(m1(i),I=1,3), nres2,(m2(i),I=1,3),d
110	if (d.le.thresh) write (6,1200) ASTRING
c111	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