PROGRAM checkocc

c	Lists atoms with OCC != 1 and writes file with all OCC=1

	CHARACTER*132 	line

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

	WRITE (6, 1000) 'Enter filename for output file:'
	READ (5, 1000) line
	OPEN (unit=2, status='UNKNOWN', file=line, form='FORMATTED')

c	Loop

	DO WHILE (.TRUE.)
	  READ (1, 1000, end=99) line
	  IF (line(1:4) .EQ. 'ATOM' .OR. line(1:6) .EQ. 'HETATM') THEN	
	    READ (line(55:60), 2000) occ
2000	    FORMAT (f6.2)
	    len = length(line)
	    IF (occ .NE. 1.0) THEN
              WRITE (6, 1000) line(1:len)
              WRITE (line(55:60), 2000) 1.0
	    endIF
	  endIF
	  len = length(line)
	  WRITE (2, 1000) line(1:len)
	endDO

99	CLOSE (unit=1)
	CLOSE (unit=2)

	end

	INTEGER FUNCTION length(line)

	CHARACTER*132   line

	DO i = 132,1,-1
	  IF (line(i:i) .NE. ' ') goto 9
	endDO

9	length = i

	return
	end