PROGRAM packing2

c	List contacts between protomer A and adjacent protomers

	PARAMETER	NDIM=44000
	CHARACTER*60	file
	CHARACTER*15	label(NDIM)
	REAL		x(3,NDIM), dx(3)

	WRITE (6, 1000) 'Enter input filename:'
1000	FORMAT (a)
	READ (5, 1000) file
	OPEN (unit=1, status='OLD', file=file, readonly, form='FORMATTED')

c	Read and store data

	DO i = 1,3
	  READ (1, 1000)
	endDO
	num = 1
	DO WHILE (.TRUE.)
	  READ (1, 1001, end=99) (x(i,num), i=1,3), label(num)
1001	  FORMAT (3f10.4, 34x, a)
	  num = num+1
	endDO

99	CLOSE (unit=1)
	num = num-1
	TYPE *, num

c	Loop through list looking for distances < 3.6 Ang.  First
c	define unit cell parameters

	aa = 197.17
	bb = 127.03
	cc = 134.18
	beta = 97.64

c	Loop through checking orthogonal distance

	cb2 = 2.*COSD(beta)
	DO n = 1,num
	  IF (label(n)(8:8) .EQ. 'A') THEN
	    DO m = 1,num
	      IF (label(m)(8:8) .NE. 'A') THEN
	        DO i = 1,3
	          dx(i) = x(i,n)-x(i,m)
	        endDO
	        dd = dx(1)**2+dx(2)**2+dx(3)**2+cb2*dx(1)*dx(3)
	        IF (dd .LE. 12.96) THEN
	          WRITE (6, 1002) label(n), SQRT(dd), label(m)
1002	          FORMAT (5x, a, f8.4, 2x, a)
	        endIF
	      endIF
	    endDO
	  endIF
	endDO

	stop
	end