PROGRAM newnum

c	Renumbers solvent in WH file.  If compressed input, then compressed
c	output

	CHARACTER*65	line, filin, filout, filnam
	INTEGER		newsol(601:999)/399*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', readonly, form='FORMATTED')
	WRITE (6, 1000) 'Enter filename for output WH file:'
	READ (5, 1000) filout
	OPEN (unit=2, file=filout, status='UNKNOWN', form='FORMATTED', 
	1	carriagecontrol='LIST')

c	First pass through to determine renumbering

	num = 600
	DO WHILE (.TRUE.)
	  READ (1, 1000, end=10) line
	  IF (line(2:6) .EQ. '1 WAT') THEN
	    READ (line(9:11), 1001) nres
1001	    FORMAT (i3)

c	Decompress if needed

	    IF (line(13:13) .NE. ' ') THEN
	      READ (line(13:13), 1002) iat
1002	      FORMAT (i1)
	      nres = nres-10+iat
	    endIF

	    num = num + 1
	    newsol(nres) = num
	  endIF
	endDO

c	Close and reopen input file

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

c	Second pass 

	DO WHILE (.TRUE.)
	  READ (1, 1000, end=20) line

c	Handle compression

	  IF (line(4:6) .EQ. 'WAT') THEN
	    IF (line(13:13) .NE. ' ') THEN
	      READ (line(13:13), 1002) iat
	      READ (line(9:11), 1001) nres
	      nres = nres-10+iat
	      nres = newsol(nres)
	      iat = MOD(nres,10)
	      nres = nres-iat+10
	      WRITE (line(13:13), 1002) iat
	      WRITE (line(9:11), 1001) nres
	    ELSE
	      READ (line(9:11), 1001) nres
	      nres = newsol(nres)
	      WRITE (line(9:11), 1001) nres
	    endIF
	  endIF

	  WRITE (2, 1000) line
	endDO

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

c	Write out renumbering array

	WRITE (6, 1000) 'Enter filename for renumbering:'
	READ (5, 1000, end=99) filnam
	OPEN (unit=2, file=filnam, status='UNKNOWN', form='FORMATTED', 
	1	carriagecontrol='LIST')
	DO i = 601, 999
	  IF (newsol(i) .NE. 0) THEN
	    WRITE (2, 1003) i, newsol(i)
1003	    FORMAT (2i5)
	  endIF
	endDO
	CLOSE (unit=2)
99	stop
	end