C     RIOPKG - DISK I/O PACKAGE FOR VERSAPLOT
C
C     NAME: RIOPKG - DISK I/O ROUTINES
C
C    LANGUAGE:  FORTRAN
C
C    OPERATING SYSTEM:  UNIVERSAL
C
C    ORDER NUMBER:  5428-SE
C
C    PART NUMBER:  000-026366  NOVEMBER 1985
C
C    PRODUCT:  UNIVERSAL VERSAPLOT COLOR RANDOM 2.0
C
C    VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051
C    A XEROX COMPANY
C
C    Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
C
C    "NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC,
C    INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED
C    LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO
C    PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE
C    REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE
C    THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF
C    VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE
C    AGREEMENT.  THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER
C    THE COPYRIGHT ACT OF 1976."
C
C
C     SUBROUTINES TO PERFORM DISK I/O OPERATIONS
C
C     THE ROUTINES (ROPEN, RREAD, RWRIT, RWAIT, RCLOS) ARE
C     USED TO CREATE AND MANIPULATE THE INTERMEDIATE FILE.
C
C     ROPEN(IARG) - OPEN VERSAPLOT DATA FILE
C         IARG = 1 - OPEN A NEW FILE
C         IARG = 2 - OPEN AN EXISTING FILE
C
C     RWAIT - WAIT FOR I/0 COMPLETION
C
C     RWRIT (BUFFER,IREC) - WRITE A RECORD
C         BUFFER - ADDRESS OF BUFFER TO WRITE FROM
C         IREC   - DISK RECORD NUMBER
C
C     RREAD (BUFFER,IREC) - READ A RECORD
C         BUFFER - ADDRESS OF BUFFER TO READ INTO
C         IREC   - DISK RECORD NUMBER
C
C     RCLOS - CLOSE VERSAPLOT DATA FILE.
C
C*************************************************************
      SUBROUTINE ROPEN(IFUNC)
C
C     ROPEN - OPEN VERSAPLOT VRF FILE
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C-E   ERROR MESSAGE
1     FORMAT(4X,9HROPEN  - ,10HOPEN ERROR,/)
C-E
C
C
C...  PROCESS CALL
      GO TO (100,200) ,IFUNC
C
C...  OPEN A NEW FILE, BUT FIRST DELETE EXISTING
  100 OPEN (UNIT=IUNIT,FILE='RANDOM.RAN',ACCESS='DIRECT',
     1      STATUS='OLD',ERR=110)
C
C...  DELETE OLD FILE
      CLOSE (UNIT=IUNIT,STATUS='DELETE')
C
C...  OPEN A NEW FILE
  110 OPEN (UNIT=IUNIT,FILE='RANDOM.RAN',ACCESS='DIRECT',
     1      STATUS='NEW',RECL=LREC,ERR=900)
      RETURN
C
C...  OPEN AN OLD FILE
  200 OPEN (UNIT=IUNIT,FILE='RANDOM.RAN',ACCESS='DIRECT',
     1      STATUS='OLD',ERR=900)
      RETURN
C-E
C...  OUTPUT ERROR MESSAGE AND STOP
  900 WRITE (LUNIT,1)
      STOP
C-E
C
      END
C*************************************************************
      SUBROUTINE RWAIT
C
C     RWAIT - WAIT FOR I/O COMPLETION.
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C
C
C...  WAIT FOR I/0 COMPLETE
C
C     FOR SYSTEMS WHERE DOUBLE BUFFERING OF I/O IS ALLOWED,
C     CODE SHOULD BE INSERTED HERE TO CHECK AND WAIT
C     FOR THE PREVIOUS READ/WRITE TO BE COMPLETED.
C
      RETURN
      END
C*************************************************************
      SUBROUTINE RWRIT(IBUF,IREC)
C
C     RWRIT - WRITE A RECORD
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C
      DIMENSION IBUF(1)
C
C...  FORMAT STATEMENTS
C-E   ERROR MESSAGES
1     FORMAT(4X,9HRWRIT  - ,11HWRITE ERROR,/)
C-E
C
C...  WAIT FOR PREVIOUS I/O DONE
c     CALL RWAIT
C
C...  WRITE A RECORD
      WRITE (UNIT=IUNIT,REC=IREC,ERR=900) (IBUF(N),N=1,LREC)
C
C...  NORMAL RETURN
      RETURN
C-E
C...  WRITE ERROR OUTPUT MESSAGE
  900 WRITE(LUNIT,1)
C-E
      STOP
      END
C*************************************************************
      SUBROUTINE RREAD(IBUF,IREC)
C
C     RREAD - READ A RECORD
C
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C
      DIMENSION IBUF(1)
C
C...  FORMAT STATEMENTS
C-E   ERROR MESSAGES
1     FORMAT(4X,9HRREAD  - ,10HREAD ERROR,/)
C-E
C
C...  WAIT PREVIOUS I/O DONE
c     CALL RWAIT
C
C...  READ A RECORD
      READ (UNIT=IUNIT,REC=IREC,ERR=900) (IBUF(N),N=1,LREC)
C
C...  NORMAL RETURN
      RETURN
C
C-E
C...  READ ERROR OUTPUT MESSAGE
  900 WRITE(LUNIT,1)
C-E
      STOP
      END
C*************************************************************
      SUBROUTINE RCLOS
C
C     RCLOS - CLOSE THE VERSAPLOT VRF FILE.
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C
C...  FORMAT STATEMENTS
C-E   ERROR MESSAGES
1     FORMAT(4X,9HRCLOS  - ,11HCLOSE ERROR,/)
C-E
C
C...  WAIT PREVIOUS I/O DONE
c     CALL RWAIT
C
C...  CLOSE AND SAVE FILE
      CLOSE (UNIT=IUNIT,STATUS='KEEP',ERR=900)
      RETURN
C-E   OUTPUT ERROR MESSAGE
  900 WRITE(LUNIT,1)
C-E
      STOP
      END