PROGRAM averocc2

c	Takes a WH file and averages the occupancies residues .GE. 550 with
c	quantitation = .2

	CHARACTER*65	line, filin, filout 
	CHARACTER*4	label, res
	CHARACTER*1	chain
	REAL		sumo(550:999)/450*0./
	INTEGER		numo(550:999)/450*0/

c	Get file names

	WRITE (6, 1000) 'Enter filename for input WH file:'
1000	FORMAT (a)
	READ (5, 1000) filin
	OPEN (unit=1, file=filin, status='OLD', form='FORMATTED')
	WRITE (6, 1000) 'Enter filename for output WH file:'
	READ (5, 1000) filout
	OPEN (unit=2, file=filout, status='UNKNOWN', form='FORMATTED')

c	First pass through, pass protein and do sums 

	natom = 0
	DO WHILE (.TRUE.)
	  READ (1, 1000, end=10) line
	  READ (line, 1001) ich, res, nres, label, x, y, z, b, wt
1001	  FORMAT (1x, i1, a4, 2x, i3, a4, 5f10.4)

	  IF (nres .LT. 550) THEN
	    WRITE (2, 1000) line
	  ELSE

c	Decompress solvents if needed

	    IF (res .EQ. 'WAT' .AND. label(2:2) .NE. ' ') THEN
	      READ (label(2:2), 1002) iat
1002	      FORMAT (i1)
	      nres = nres-10+iat
	    endIF

 	    sumo(nres) = sumo(nres)+wt
	    numo(nres) = numo(nres)+1
	  endIF
	endDO

c	Close and reopen input file.

10	CLOSE (unit=1)
	OPEN (unit=1, file=filin, status='OLD', readonly, form='FORMATTED')

c	Average occupancies with quantization

	DO i = 550,999
	  sumo(i) = sumo(i)/MAX(1,numo(i))
	  sumo(i) = NINT(5.*sumo(i))/5.
	endDO

c	Second pass.  Apply <occ>.

	DO WHILE (.TRUE.)
	  READ (1, 1000, end=20) line
	  READ (line, 1001) ich, res, nres, label, x, y, z, b, wt

	  IF (nres .GE. 550) THEN

c	Decompress solvents if needed

	    IF (res .EQ. 'WAT' .AND. label(2:2) .NE. ' ') THEN
	      READ (label(2:2), 1002) iat
	      nres = nres-10+iat
	    endIF

	    wt = sumo(nres)
	    WRITE (line(56:65), 1003) wt
1003	    FORMAT (f10.4)
	    WRITE (2, 1000) line
	  endIF
	endDO

20	CLOSE (unit=1)
	CLOSE (unit=2)

	end