C***  THIS SUBROUTINE OPENS, CLOSES, READS, WRITES, AND
C***  POSITIONS DISK FILES WRITTEN FOR 'REMAPP' FORMAT
C***  PROGRAMS.
C***
C***  USAGE: CALL DISKIO(OPER,LU,IOAREA,FCB)
C***
C***  WHERE
C***
C***  OPER = I/O OPERATION TO BE PERFORMED
C***       = 0, OPEN A DISK FILE.
C***             IF FCB(1)=0, OPEN AN INPUT FILE
C***                      >0, OPEN AN OUTPUT FILE
C***             FCB(1) DEFINES THE NUMBER OF BITS PER DATA
C***             BYTE WHEN OPENING AN OUTPUT FILE.
C***
C***       = 1-2, NOT USED
C***
C***       = 3, REWIND THE DISK FILE TO THE FIRST DATA RECORD
C***
C***       = 4, SKIP FCB(1) RECORDS
C***
C***       = 5, BACKSPACE FCB(1) RECORDS
C***
C***       = 6-8, CLOSE THE FILE
C***
C***       = 9, READ A DATA RECORD
C***
C***       = 10, WRITE A DATA RECORD
C***
C***       = 11, POSITION FILE TO RECORD FCB(1)
C***
C***       = 12-13, NOT USED
C***
C***  LU = LOGICAL UNIT NUMBER FOR THE FILE
C***
C***  IOAREA = I/O BUFFER USED TO TRANSFER DATA
C***
C***  FCB = FILE CONTROL BLOCK FOR THE FILE
C***
C***  THIS SUBROUTINE DOES NOT DO ANY PACKING OR UNPACKING OF DATA
C***
C*****************************************************************
        SUBROUTINE DISKIO(OPER,LU,IOAREA,FCB)
      LOGICAL*1 IOAREA(1)
      INTEGER*4 FCB(128),OPER,LU,TTYIN,TTYOUT,ISIZE
      INTEGER*4 CODE,HEADER(4),IHEADR,NBYTES
      CHARACTER NFILE*50,JFILE*16
      EQUIVALENCE(HEADER(1),JFILE)
      DATA TTYIN/5/,TTYOUT/6/
      NBYTES=512
C  NBYTES= MAX FILE SIZE  16 BIT * (8192 PIXELS)
C
C  ENTRY POINT AND BRANCH VECTOR TO OPERATION ROUTINES
C
      JUMP=OPER+1
      IF(JUMP.GT.14.OR.JUMP.LT.1) GOTO 5
      GO TO (30,20,20,100,110,120,200,200,200,140,190,130,20,20)JUMP
5     WRITE(TTYOUT,10)
10    FORMAT(1X,'DISKIO:INVALID OPERATION CODE')
      STOP
C
C  RETURN
20    RETURN
C
C  FILE OPENING PROCEDURES
C
30       FCB(20)=LU
       DO 2 I=1,4
      FCB(I+7)='    '
2      NFILE='    '
       IF(FCB(1).EQ.0)WRITE(TTYOUT,11)
11     FORMAT(1X,'DISKIO:ENTER INPUT FILENAME ')
       IF(FCB(1).GT.0)WRITE(TTYOUT,12)
12     FORMAT(1X,'DISKIO:ENTER OUTPUT FILENAME ')
       READ(TTYIN,13)NFILE
      IHEADR=0
      DO 199 K=1,50
         IF (NFILE(K:K).EQ.'\' .OR. NFILE(K:K).EQ.':') IHEADR=K
199   CONTINUE
      K=IHEADR
      IF(K.EQ.0) THEN
      JFILE=NFILE(1:12)
      ELSE
      L=12
      JFILE=NFILE(K+1:K+L)
      ENDIF
      DO 141,IHEADR=1,4
         FCB(IHEADR+7)=HEADER(IHEADR)
141   CONTINUE
13     FORMAT(A50)
14    FORMAT(A16)
       L=0
       J=0
      IF(FCB(1).NE.0)GO TO 80
C
C  OPEN INPUT FILE
C
      OPEN(LU,FILE=NFILE,STATUS='OLD',FORM='BINARY',
     & RECL=NBYTES,IOSTAT=CODE,ACCESS='DIRECT')
      IF(CODE.NE.0) WRITE(6,399) CODE
399   FORMAT(/1X,'DISKIO: OPEN ERROR = ',I3)
      IF(CODE.NE.0)GO TO 300
      READ(LU,REC=1,ERR=300) FCB
      CLOSE(LU)
      NBYTES=FCB(12)
      OPEN(LU,FILE=NFILE,STATUS='OLD',FORM='BINARY',
     & RECL=NBYTES,IOSTAT=CODE,ACCESS='DIRECT')
      IF(CODE.NE.0) WRITE(6,399) CODE
      IF(CODE.NE.0)GO TO 300
C
      WRITE(TTYOUT,61)
61      FORMAT(1X,'ENTER 1ST SCANLINE, NO. SCANLINES, SKIPS: ')
      READ(TTYIN,*) FCB(5),FCB(16),FCB(7)
      WRITE(TTYOUT,62)
62      FORMAT(1X,'ENTER 1ST PIXEL, NO. PIXELS, SKIPS: ')
      READ(TTYIN,*) FCB(4),FCB(15),FCB(6)
C.....DEFAULT STARTING VALUES
      IF(FCB(5).LE.0) FCB(5)=1
      IF(FCB(4).LE.0) FCB(4)=1
C.....STARTING VALUES TOO LARGE?
      IF(FCB(4).GT.FCB(23)) FCB(4)=FCB(23)
      IF(FCB(5).GT.FCB(24)) FCB(5)=FCB(24)
C.....NOS. TOO LARGE?
      IF(FCB(4)+FCB(15)-1.GT.FCB(23)) FCB(15)=FCB(23)-FCB(4)+1
      IF(FCB(5)+FCB(16)-1.GT.FCB(24)) FCB(16)=FCB(24)-FCB(5)+1
C.....DEFAULT WINDOW LENGTHS
      IF(FCB(15).LE.0) FCB(15)=FCB(23)-FCB(4)+1
      IF(FCB(16).LE.0) FCB(16)=FCB(24)-FCB(5)+1
C.....LAST RECORD
      FCB(26)=FCB(5)+FCB(16)-1
      IF(FCB(26).GT.FCB(24)) FCB(26)= FCB(24)
      FCB(26)=FCB(26)+1
C.....FIRST RECORD
      FCB(14)=FCB(5)+1
C.....LAST PIXEL
      FCB(27)=FCB(4)+FCB(15)-1
      IF(FCB(27).GT.FCB(23)) FCB(27)=FCB(23)
C.....ACTUAL NO. PIXELS AND SCANLINES
      FCB(2)=(FCB(15)-1)/(FCB(6)+1)+1
      FCB(3)=(FCB(16)-1)/(FCB(7)+1)+1
C
      WRITE(TTYOUT,70) (FCB(I),I=8,11),FCB(24),FCB(23),FCB(25)
70    FORMAT(1X,T10,'DISKIO(2): ',4A4,'[LINES ',I5,
     *'PIXELS ',I4,'BYTESIZE ',I2']')
      FCB(21)=0
      WRITE(4,72) (FCB(I),I=8,11)
72    FORMAT(1X,T15,'INPUT FILE ',4A4,' OPENED:')
      WRITE(4,71) FCB(5),FCB(16),FCB(7),FCB(3),FCB(4),FCB(15),FCB(6)
     *,FCB(2)
71    FORMAT(1X,T20,'WINDOW',T32,'1ST',T37,'NO.',T41,'SKIP',
     *T46,'ACTUAL',/,1X,T20,'SCANLINES',T30,4I5,/
     *,1X,T20,'PIXELS',T30,4I5)
       FCB(21)=0
      GO TO 20
C
C OPEN AN OUTPUT FILE
C
80    CONTINUE
      FCB(14)=2
      FCB(21)=1
      FCB(25)=FCB(1)
      FCB(23)=FCB(2)
      FCB(12)=FCB(23)*FCB(25)/8
      FCB(24)=0
      IF (FCB(12) .LT. 100) THEN
         WRITE(*,*) 'OUTPUT RECORD LENGTH TOO SHORT [100 BYTE MIN]'
         WRITE(*,*) 'CURRENT OUTPUT RECORD = ',FCB(12)
         STOP
      ENDIF
      NBYTES=FCB(12)
      OPEN(LU,FILE=NFILE,STATUS='NEW',FORM='BINARY',
     &RECL=NBYTES,IOSTAT=CODE,ACCESS='DIRECT')
      IF(CODE.NE.0) WRITE(6,398) CODE
398   FORMAT(1X,'DISKIO: CREATE ERROR = ',I3)
      IF(CODE.NE.0)GO TO 300
      WRITE(LU,REC=1,ERR=300) FCB
      FCB(14)=2
      GO TO 20
C
C  REWIND - POINT TO FIRST DATA RECORD
C
100   FCB(14)=2
      GO TO 20
C
C  SKIP SPECIFIED NUMBER OF RECORD
110   FCB(14)=FCB(14)+FCB(1)
      GO TO 20
C
C  BACKSPACE SPECIFIED NUMBER OF RECORDS
C
120   FCB(14)=FCB(14)-FCB(1)
      GO TO 20
C
C  POSITION TO A SPECIFIC RECORD
C
130   FCB(14)=FCB(1)+1
      GO TO 140
C
C READ A RECORD
C
140   FCB(1)=0
      IF(FCB(14).LT.FCB(5)+1) GOTO 300
      IF(FCB(14).LE.FCB(26)) GO TO 142
      WRITE(TTYOUT,180)(FCB(I),I=8,11)
180   FORMAT(1X,'DISKIO:END OF FILE ON ',4A4)
      FCB(1)=-1
       GO TO 20
142   READ(LU,REC=FCB(14),ERR=300) (IOAREA(I),I=1,FCB(12))
C      WRITE(6,*)' READING RECORD # ',FCB(14)
C      WRITE(6,191) (IOAREA(I),I=1,16)
      FCB(14)=FCB(14)+1+FCB(7)
C
C  EXTRACT A SUBSET OF LINE IF DESIRED
C
      IF(FCB(4).EQ.1.AND.FCB(6).EQ.0)GO TO 160
      I=1
      KMUL=FCB(25)/8
      KST=(FCB(4)-1)*KMUL +1
      KEND=(FCB(27)-1)*KMUL +1
      KINC=(FCB(6)+1)*KMUL
      DO 150 K=KST,KEND,KINC
      DO 150 J=K,K+KMUL-1
      IOAREA(I)=IOAREA(J)
150   I=I+1
160   GO TO 20
C
C WRITE A RECORD
C
190   WRITE(LU,REC=FCB(14),ERR=300) (IOAREA(I),I=1,FCB(12))
      FCB(24)=FCB(24)+1
      FCB(14)=FCB(14)+1

C     IF(FCB(14).LE.5) THEN
C      WRITE(6,*)' WRITING RECORD # ',FCB(14)
C191   FORMAT(16Z2)
C      WRITE(6,191) (IOAREA(I),I=1,16)
C     END IF
      GO TO 20
C
C  CLOSE A FILE
200   IF(FCB(21).LE.0)GO TO 201
C
C  CLOSE OUTPUT FILE - WRITE FCB
C
      FCB(2)=FCB(23)
      FCB(3)=FCB(24)
      WRITE(TTYOUT,70)(FCB(I),I=8,11),FCB(24),FCB(23),FCB(25)
      IREC=128
      IF (FCB(12) .LT. 512) IREC=FCB(12)/4
      WRITE(LU,REC=1,ERR=300)(FCB(I),I=1,IREC)
201   CLOSE(LU,IOSTAT=CODE)
      IF(CODE.NE.0)GO TO 300
      IF(FCB(21).LE.0)GO TO 20
      WRITE(4,202)
202   FORMAT(1X,T15,'OUTPUT SEGMENT CLOSED:')
      WRITE(4,70)(FCB(I),I=8,11),FCB(24),FCB(23),FCB(25)
      GO TO 20
C
C  FINIS
C
300   FCB(1)=-2
      WRITE(TTYOUT,181)(FCB(I),I=8,11)
181   FORMAT(1X,'DISKIO:ERROR ON FILE ',4A4)
      GO TO 20
      END
