C     NAME: TIOPKG
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     TIOPKG - THIS TEST PROGRAM IS PROVIDED FOR A GUIDE TO IMPLEMENTORS
C             OF UNIVERSAL VERSAPLOT. THE TEST PROGRAM MAKES USE OF ALL
C             THE FEATURES AND FUNCTIONS THE IOPKG OFFERS.
C
C     CALLS: ROPEN,RCLOS,RREAD,RWRIT,RWAIT
C
C     COMMON USED:
C     /IOCOM/
C            I LUNIT   - LOGICAL UNIT NUMBER OF LISTING DEVICE
C            I IUNIT   - LOGICAL UNIT NUMBER OF VERSAPLOT DATA FILE
C            I LREC    - LENGTH OF DATA FILE RECORD IN WORDS
C
C     LOCAL VARIABLES USED:
C          I IBUF   - THE BUFFER AREA
C          I IREC   - THE CURRENT RECORD NUMBER
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C...  THE FOLLOWING DECLARATIONS MAY NEED TO BE CHANGED FOR DIFFERENT
C     COMPUTERS.
C
C*****  SYSTEM DEPENDENT VARIABLES *****
      DIMENSION IBUF(128)
      IUNIT = 1
      LUNIT = 6 
      IREC = 1
      LREC = 128
C*****
C
C
C...  OPEN RANDOM.RAN FILE AS A NEW FILE BEING CREATED
      CALL ROPEN(1)
C
C
C...  FOR TEN RECORDS
      DO 20 IREC=1,10
C
C...  CREATE DATA
      DO 10 J=1,LREC
   10 IBUF(J)=100+IREC
C
C...  OUTPUT DATA
      CALL RWRIT(IBUF,IREC)
   20 CALL RWAIT
C
C...  READ THE RECORDS AND VERIFY
      DO 40 IREC=1,10
      CALL RREAD(IBUF,IREC)
      CALL RWAIT
C
      DO 30 J=1,LREC
   30 IF(IBUF(J).NE.(100+IREC))GO TO 920
C
   40 CONTINUE
C
C...  CLOSE THE FILE
      CALL RWAIT
      CALL RCLOS
C
C...  OPEN FILE AS AN EXISTING FILE
      CALL ROPEN(2)
      DO 260 IREC = 1,10
      CALL RREAD(IBUF,IREC)
      CALL RWAIT
C
C...  COMPARE DATA READ
      DO 250 L=1,LREC
  250 IF(IBUF(L).NE.(100+IREC))GO TO 930
  260 CONTINUE
C
C...  NOW APPEND TO FILE
      IREC = 11
C
C...  CREATE DATA FOR RECORD #11
      DO 50 I = 1,LREC
   50 IBUF(I) = IREC + 100
C
C...  OUTPUT RECORD #11
      CALL RWRIT(IBUF,IREC)
      CALL RWAIT
C
C...  NOW CHECK DATA
      DO 60 I = 1,LREC
   60 IBUF(I) = 0
      CALL RREAD (IBUF,IREC)
      CALL RWAIT
      DO 70 I = 1,LREC
      IF (IBUF(I) .NE. (IREC+100)) GO TO 930
   70 CONTINUE
C
C...  CLOSE FILE FOR ONCE AND FOR ALL
      CALL RCLOS
C
C     CORRECT OPERATION OF IOPKG
      WRITE (LUNIT,5)
    5 FORMAT (27H CORRECT OPERATION OF IOPKG,//)
C
      STOP
C
C
C...  ERROR EXITS FOLLOW
C
C...  ERROR IN CHECKING DATA
  920 KK=100 + IREC
      WRITE(LUNIT,1)KK,IBUF(J),IREC
    1 FORMAT(18H DATA SHOULD BE = ,I10,/,7H WAS = ,I10,/,
     1       10H RECORD = ,I10,//)
      STOP
C
  930 KK=100 + IREC
      WRITE(LUNIT,1)KK,IBUF(L),IREC,IUNIT
      STOP
C
      END