PROGRAM RINDX
C ...	This program attempts to reconstruct the INDEXF.SYS
c ...	file by reading blocks from disk with starting bytes 
c ...		1 26
c ..		2 41
c ..	 	3 FF
c ..		4 FF
	Integer*2 file_nr, file_name(10)
	equivalence (file_nr, data(9)) , (file_name, data(77))
	1, (nmap_words, data(59))
	Byte Data(512), nmap_words
c ........ open a new INDEX file on the good disk (of course)
	Open(Unit=3,Name='sia0:[adapt.disk]newindexf.sys',
	1 Access = 'Direct', Recordsize = 60, Maxrec = 7000,
	2 Organization = 'Relative', Type = 'New' )
	nmap_max = 0
c
10	continue
c......... RINDX permits you to enter the starting and ending block
c .......   numbers to read from the bad disk
	Print 1
1	Format(' Enter starting block number: '$)
	Read *,Nblock1
	if(Nblock1 .eq. 0)Then
	print *,' Nmap_max_fl, Nmap_max: ',Nmap_max_fl, Nmap_max
	stop
	end if
	Print 2
2	Format(' Enter ending block number: '$)
	Read *,Nblock2
	If(Nblock2 .eq. 0)Then
	Nblock2 = Nblock1
	end if
	ncount = 0
c ........ loop
	Do jblock = Nblock1, Nblock2
	Call Rdblock(Jblock, Data)
	If(Data(1) .eq. '26'x .and. Data(2) .eq. '41'x
	1  .and. Data(3) .eq. 'FF'x .and. Data(4) .eq. 'FF'x)Then
	If(File_nr .gt. 0 .and. file_nr .le. 7000)Then
c ..		Hey!! We found one!
	if(nmap_words .gt. nmap_max)Then
	nmap_max = nmap_words
	nmap_max_fl = file_nr
	end if
c........ This version of RINDX stores only a portion of the header to
c ...... save disk space in the index file.  The 240 could be increased to
c ...... 512 to save the entire header.  This program does not deal with
c ...... multi-header files, since we did not have any such files on the bad
c ...... disk.  The mods here should not be extensive.
	Write(3,rec=File_nr)(Data(i),i=1,240)
	ncount = ncount + 1
	Print 6,jblock,File_nr, File_name
6	Format(3x,i7,i6,4x,10a2)
	end if
	end if
	end do
	print *,' Number of files: ', ncount
	go to 10
	end
	Subroutine Rdblock(Block,Data)
c ...... This program reads block number BLOCK into DATA
      IMPLICIT INTEGER*4 (A-Z)
	Byte Data(512)
      INTEGER*2 STATUS(4)
      INTEGER*4 DEVDEPINF
      INTEGER*2 NUMBYTES, QIOSTAT
      EQUIVALENCE (STATUS(1),QIOSTAT)
      EQUIVALENCE (STATUS(2),NUMBYTES)
      EQUIVALENCE (STATUS(3),DEVDEPINF)
	Data First /0/
	If(First .eq. 0)Then
      SUCC = SYS$ASSIGN('_SIA1:',CHAN,,)
      IF(FAILURE(SUCC,'ASSIGN FAILURE'))PRINT*,CHAN
	First = 1
	End if
      SUCC = SYS$QIOW(%VAL(1),%VAL(CHAN),%VAL(33),STATUS,,,
     +Data,%VAL(512),%VAL(Block),,,)
      IF(FAILURE(SUCC,'QIO FAILURE'))PRINT*,CHAN
C     WRITE(6,10001)QIOSTAT, NUMBYTES, DEVDEPINF
C0001 FORMAT(1X,'QIOSTAT IS',Z4,'NUMBYTES IS ',I4,
C    +'DEVDEPINF IS',Z8)
	Return
      END
      LOGICAL FUNCTION FAILURE(SUCC, ERRMSG)
c ...... This routine prints the error message associated with SUCC, the
c ......  status flag returned by system services.
      IMPLICIT INTEGER*4 (A-Z)
      CHARACTER* (*) ERRMSG
      CHARACTER*60  MSG
      FAILURE = .FALSE.
      IF(SUCC .EQ. 0 .OR. SUCC .EQ. 1)RETURN
      FAILURE = .TRUE.
      IF(LEN(ERRMSG) .GT. 1)PRINT 1,ERRMSG(1:LEN(ERRMSG)),SUCC
      STAT=SYS$GETMSG(%VAL(SUCC), LENGTH, MSG, %VAL(15), )
      IF(STAT .NE. 1)RETURN
      PRINT 2, MSG(1:LENGTH)
1     FORMAT(1X,A,'.  (CODE=',Z')')
2     FORMAT(1X,A)
      RETURN
      END