PROGRAM RFAT
C
C     TO READ FAT ON DISKETTES IN FLOPPY DRIVES
C     OLYMPIC SOFTWARE  --  9/26/88
C
      EXTERNAL DBIOS,GETCAD
      INTEGER*2 IAR(7),IES,IBX
      INTEGER*2 IDATA(1024),IFCT(20)
      INTEGER*2 I,I1,J,K,IH(6),IC1,IC2,ID,ID1,ID2
      CHARACTER*1 ICDAT(1024),AB(2)
      CHARACTER*2 AH(8),AC
      EQUIVALENCE (AB(1),AC)
C
C***  GET ADDRESS OF ICDAT
      CALL GETCAD(ICDAT,IES,IBX)
C
C**   RESET DISKETTE SYSTEM
      IAR(1)=0
      CALL DBIOS(IAR,IES,IBX)
C
      IAR(1)=2
      IAR(2)=2
C
      WRITE(*,10)
 10   FORMAT(' ENTER DOS SECTOR #(1 FOR 360K), DRIVE #(0 FOR "A"): ',$)
      READ(*,*)I,IAR(6)
C
C**   BIOS SECTOR, SIDE, TRACK...
      IAR(4)=1+I-INT(I/9.0)*9
      IAR(5)=(I/9.0)-INT(I/18.0)*2
      IAR(3)=I/(18.0)
C
      CALL DBIOS(IAR,IES,IBX)
C
      IF(IAR(7).EQ.1)THEN
       WRITE(*,101)IAR(1)
 101   FORMAT(' *** DISK ACCESS ERROR ! ',I5)
       GOTO 700
      ENDIF
C
      DO 29 I=1,1024
      IDATA(I)=ICHAR(ICDAT(I))
 29   CONTINUE
C
      DO 30 I=1,1024,8
      I1=I-1
C
C**    CONVERT TO HEX IN ALPHANUMERIC TERMS
       DO 31 K=1,8
       ID=IDATA(I1+K)
       ID1=ID/16.0
       ID2=ID-ID1*16
       IF(ID1.LT.10)THEN
         AB(1)=CHAR(ID1+48)
       ELSE
         AB(1)=CHAR(ID1+55)
       ENDIF
       IF(ID2.LT.10)THEN
         AB(2)=CHAR(ID2+48)
       ELSE
         AB(2)=CHAR(ID2+55)
       ENDIF
       AH(K)=AC
 31    CONTINUE
C
      WRITE(*,20)I1,(IDATA(I1+J),J=1,8),(AH(J),J=1,8)
 20   FORMAT(1X,I4,5X,8I4,10X,8(A2,1X))
 30   CONTINUE
C
C**   DISCRAMBLE FOR FAT
      K=0
      J=-2
      DO 40 I=1,534,3
      J=J+2
      I1=J+1
      IH(1)=IDATA(I)/16.0
      IH(2)=IDATA(I)-IH(1)*16
      IH(3)=IDATA(I+1)/16.0
      IH(4)=IDATA(I+1)-IH(3)*16
      IH(5)=IDATA(I+2)/16.0
      IH(6)=IDATA(I+2)-IH(5)*16
C
      IC1=IH(2)+IH(1)*16.0+IH(4)*256.0
      IC2=IH(3)+IH(6)*16.0+IH(5)*256.0
      WRITE(*,90)J,IC1,I1,IC2
 90   FORMAT(3X,'CLUSTER NO. ',I4,'  CONTAINS ',I4,'  AND CLUSTER NO. ',
     1 I4,'  CONTAINS ',I4)
C
C**   RECORD FAULTS
      IF(IC1.EQ.4087)THEN
        K=K+1
        IFCT(K)=J
      ENDIF
      IF(IC2.EQ.4087)THEN
        K=K+1
        IFCT(K)=I1
      ENDIF
C
 40   CONTINUE
C
C**   PRINT FAULTS
      IF(K.NE.0)WRITE(*,62)
 62   FORMAT(/,' BAD CLUSTERS...',/)
      DO 60 I=1,K
      WRITE(*,61)I,IFCT(I)
 61   FORMAT(1X,2I5)
 60   CONTINUE
C
 700  STOP
      END