PROGRAM 	next

c	Makes new PROLSQ command file

	REAL		pos(10), therm(10), rv(10), array(30)
	CHARACTER*80	line

c	Get current cycle and starting cycle

	READ (5, 1000) icycle, jcycle
1000	FORMAT (2i5)

c	Form file name and open them

	line(1:25) = '/m/h5/mg36001/pcd/prolsq.'
	WRITE (line(26:28), 1001) icycle
1001	FORMAT (2i3)
	OPEN (unit=1, form='FORMATTED', status='UNKNOWN', file=line)
	WRITE (line(26:28), 1001) icycle-1
	OPEN (unit=2, form='FORMATTED', status='OLD', file=line)
	line(1:29) = '/m/h5/mg36001/pcd/prolsq.log.'
	WRITE (line(30:32), 1001) icycle-1
	OPEN (unit=4, form='FORMATTED', status='OLD', file=line)

c	First read through log file to check number of hydrogen bonds

	DO WHILE (.TRUE.)
	  READ (4, 1002) line
1002	  FORMAT (a)
	  IF (line(11:24) .EQ. 'HYDROGEN BONDS') THEN
	    READ (line(4:9), 10021) nhbd
10021	    FORMAT (i6)
	    IF (nhbd .GT. 7000) GOTO 5
	    CLOSE (unit=1, status='DELETE')
	    CLOSE (unit=2)
	    stop
	  endIF
	endDO

c	Next read log file for new shifts and scale factor adjustment

5	DO WHILE (.TRUE.)
	  READ (4, 1002) line
	  IF (line(2:4) .EQ. 'ALL' .OR. line(3:5) .EQ. 'ALL') THEN
	     READ (line(65:74), 1003) scl
1003	     FORMAT (f10.3)
	     GOTO 10
	  endIF
	endDO

10	n = 1
	DO WHILE (.TRUE.)
	  READ (4, 1002, end=19) line
	  IF (line(1:10) .EQ. 'POSITIONAL' .OR. 
	1	line(2:11) .EQ. 'POSITIONAL') THEN
	    READ (line(22:28), 1004) pos(n)
1004	    FORMAT (f7.3)
	    READ (line(47:53), 1004) therm(n)
	    DO WHILE (.TRUE.)
	      READ (4, 1002) line
	      IF (line(2:4) .EQ. 'ALL' .OR. line(3:5) .EQ. 'ALL') THEN
	        READ (line(39:48), 1003) rv(n)
	        GOTO 15
	      endIF
	    endDO
15	    n = n + 1
	  endIF
	endDO

19	CLOSE (unit=4)

c	Find shifts which give minimum Rvalue

	rmin = 1.0
	DO n = 1,10
	  IF (rv(n) .LE. rmin .AND. pos(10) .EQ. pos(n)) THEN
	    imin = n
	    rmin = rv(n)
	  endIF
	endDO

c	Now edit profft.xxx file

	READ (2, 1002) line
	READ (line(47:50), 1005) snr
1005	FORMAT (f4.2)
	IF (icycle-jcycle .LT. 6) THEN		! first 6 cycles with 3 sigma data
	  snr = 3.0
	ELSE IF (MOD(icycle,2) .EQ. 1) THEN	! other cycles decrement snr
 	  snr = MAX(0.01,snr-1)			! for each pair of cycles
	endIF
	IF (icycle-jcycle .LE. 2) THEN		! 2 cycles at 2.8
	  res = 2.8
	ELSE IF(icycle-jcycle .LE. 4) THEN	! 2 cycles at 2.4
	  res = 2.4
	ELSE 					! rest at 2.0
	  res = 2.0
	endIF
	WRITE (line(19:21), 1001) icycle
	WRITE (line(38:40), 10051) res
10051	FORMAT (f3.1)
	WRITE (line(47:50), 1005) snr
	WRITE (1, 1002) line(1:long(line))

	DO i = 1,9
	  READ (2, 1002) line
	  WRITE (1, 1002) line(1:long(line))
	endDO

	READ (2, 1002) line
	WRITE (line(33:36), 1005) 0.5/res
	WRITE (line(43:46), 1005) snr
	WRITE (1, 1002) line(1:long(line))
	  
	READ (2, 1002) line
	WRITE (1, 1002) line(1:long(line))
	READ (2, 1002) line
c	afsig = (icycle-176)/2
c	afsig = MAX(3.,afsig/5.)
	WRITE (line(9:16), 1006) 2.8
	WRITE (1, 1002) line(1:long(line))

	DO i = 1,4
	  READ (2, 1002) line
	  WRITE (1, 1002) line(1:long(line))
	endDO

	READ (2, 1002) line
	READ (line(17:24), 1006) scale
1006	FORMAT (f8.5)
	WRITE (line(17:24), 1006) scale*scl
	WRITE (1, 1002) line(1:long(line))

	READ (2, 1002) line
	WRITE (1, 1002) line(1:long(line))

	READ (2, 1007) n, (array(i), i=1,MIN(n,15))
1007	FORMAT (i5, 15f5.2)
	IF (n .GT. 15) READ (2, 1008) (array(i), i=16,n)
1008	FORMAT (5x, 15f5.2)
	n = n + 1
	array(n) = pos(imin)
	WRITE (1, 1007) n, (array(i), i=1,MIN(n,15))
	IF (n .GT. 15) WRITE (1, 1008) (array(i), i=16,n)

	READ (2, 1007) n, (array(i), i=1,MIN(n,15))
	IF (n .GT. 15) READ (2, 1008) (array(i), i=16,n)
	n = n + 1
	array(n) = therm(imin)
	WRITE (1, 1007) n, (array(i), i=1,MIN(n,15))
	IF (n .GT. 15) WRITE (1, 1008) (array(i), i=16,n)

	READ (2, 1007) n, (array(i), i=1,MIN(n,15))
	IF (n .GT. 15) READ (2, 1008) (array(i), i=16,n)
	n = n + 1
	IF (icycle-jcycle .GE. 5) THEN		! Apply occ shifts on odd
	  array(n) = MOD(icycle,2)		! cycles after cycle 5
	ELSE
	  array(n) = 0.
	endIF
	WRITE (1, 1007) n, (array(i), i=1,MIN(n,15))
	IF (n .GT. 15) WRITE (1, 1008) (array(i), i=16,n)

	READ (2, 1002) line
	WRITE (1, 1002) line(1:long(line))

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

	end

	INTEGER FUNCTION long(line)

	CHARACTER*80	line

	DO j = 80,1,-1
	  IF (line(j:j) .NE. ' ') THEN
	    long = j
	    return
	  endIF
	endDO

	end