      SUBROUTINE PLOT ( X, Y, IPEN )
C
C     NAME:  PLOT
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     REVISION HISTORY:
C     REV. B  5/30/84      ADD CALL TO RWAIT BEFORE FINAL RWRIT
C
C             5/30/84      RENUMBER TO MATCH B/W
C
C             6/13/84      DELETE SUPERFLUOUS RWAIT CALL
C                          IN DO LOOP 1100
C
C     REV C   2/21/85      SET PMOVE TO TRUE IF THE FIRST ENDPOINT
C                          OF THE VECTOR IS OUTSIDE THE CLIPPING
C                          WINDOW.
C
C                          SUBROUTINE OUTVEC NOW USED TO OUTPUT THE
C                          VECTOR INSTEAD OF AN INLINE SUBROUTINE.
C
C                          THE NEW VARIABLES LASTX AND LASTY ARE
C                          NOW USED AND UPDATED.
C
C                          WE NOW CHECK FOR PENS THAT HAVE BEEN
C                          DEFINED AS DASHED AND WE CALL DRWPEN TO
C                          STROKE THEM OUT.
C
C                          AUTOMATIC Y-STRIPPING HAS BEEN ADDED.
C                          SUBROUTINE VSTRIP IS CALLED IF THE
C                          VECTOR CROSSES THE STRIPPING BOUNDARY.
C
C                          THE XSTRIPPING CHECK HAS BEEN MODIFIED
C                          IF THE OUTPUT IS GOING TO A PRISM.
C
C             2/25/85      SOME GLOBAL VARIABLES ARE NOW RESET
C                          AFTER THE CALL TO VRFPLT.  THIS MAKES
C                          SUBROUTINE PLOTS REENTRANT.
C
C     PLOT - CLIP AND TRANSFORM VECTORS TO PLOTTER COORDINATES
C
C     PLOT CONVERTS CALLS INTO VECTORS, AND CLIPS THESE VECTORS TO
C     THE USER DEFINED PLOTTING WINDOW.  IT ALSO DOES THE BOOKKEEPING
C     NECESSARY TO MAINTAIN THE CURRENT ORIGIN AND THE CURRENT
C     POSITION OF THE VIRTUAL PEN RELATIVE TO THAT ORIGIN.
C
C     THE CLIPPING OF VECTORS IS A PROCESS WHICH ASSURES THAT ALL
C     VECTORS GENERATED LIE WITHIN A RECTANGULAR REGION CALLED THE
C     VIEWING WINDOW.  THE VIEWING WINDOW IS DEFINED BY AN XMIN EDGE,
C     AN XMAX EDGE, A YMIN EDGE, AND A YMAX EDGE.  VECTORS WHOSE
C     ENDPOINTS ARE WITHIN THE WINDOW ARE COMPLETELY VISIBLE ON THE
C     PLOT.  VECTORS THAT CROSS WINDOW BOUNDARIES ARE PARTIALLY
C     VISIBLE AND MUST BE CLIPPED.  THE CLIPPING PROCESS CONSISTS OF
C     COMPUTING THE COORDINATES OF THE INTERSECTION OF THE VECTOR
C     WITH THE WINDOW BOUNDARY AND REPLACING THE INVISIBLE
C     ENDPOINT(S) WITH THE INTERSECTION COORDINATES.  SUBROUTINE
C     *CLIP* TAKES CARE OF CLIPPING VECTORS TO THE VIEW WINDOW.
C
C
C     ENTRY: PLOT (X,Y,IPEN)
C
C            X = X-COORDINATE (REAL)
C            Y = Y-COORDINATE (REAL)
C
C            IPEN =  +13 = MOVE TO OFFSET/SCALED (X,Y)
C                 =  +12 = DRAW TO OFFSET/SCALED (X,Y)
C             *   =   +3 = MOVE TO (X,Y)
C             *   =   +2 = DRAW TO (X,Y)
C             *   =   -2 = DRAW TO (X,Y), RE-ORIGIN
C             *   =   -3 = MOVE TO (X,Y), RE-ORIGIN
C                 =  -12 = DRAW TO OFFSET/SCALED (X,Y), RE-ORIGIN
C                 =  -13 = MOVE TO OFFSET/SCALED (X,Y), RE-ORIGIN
C                 = IEOP = END-OF-PLOT (DEFAULT = -999,+-23)
C             *   = IEOJ = END-OF-PLOT AND END-OF-JOB
C                   (DEFAULT = +999)
C
C                 THE VARIABLES IEOP AND IEOJ ARE INITIALIZED IN
C                 ROUTINE PLOTS/BLKDTA AND CAN BE SET TO ANY VALUE
C                 BY THE USER.
C
C     * DENOTES 'STANDARDIZED' PEN PLOTTER ARGUEMENTS; ADDITIONAL
C       VALUES ARE BASED ON A CONSENSUS OF CONVENTIONAL PRACTICES
C       THAT MAY VARY SOMEWHAT BETWEEN DIFFERENT PLOTTING
C       INSTALLATIONS.
C
C     NOTES:
C
C           AN END-OF-PLOT CALL MUST BE ISSUED TO COMPLETE A PLOT.
C           THE CURRENT PLOT IN PROGRESS IS ENDED AND THE SOFTWARE
C           SYSTEM INITIALIZES FOR A NEW PLOT.  THE REINITIALIZATION
C           RESTORES ALL VARIABLES (SCALES, ORIGINS, LIMITS, COPY
C           COUNT, AND SO FORTH) TO THEIR ORIGINAL SETTINGS AS
C           DEFINED FOLLOWING THE INITIAL PLOTS CALL.
C
C           WHEN AN END-OF-JOB IPEN VALUE IS ENCOUNTERED, THE CURRENT
C           PLOT IN PROCESS IS ENDED AND THE OUTPUT FILES ARE CLOSED.
C           THIS CALL MUST BE CALLED TO TERMINATE THE OUTPUT FILE
C           CORRECTLY.
C
C     EXIT:  CURRENT PEN POSITION = IF IPEN < 0 THEN (0,0) ELSE (X,Y)
C
C     CALLS: CLIP,DRWPEN,MSGLG1,OCHUNK,OUTVEC,VPINIT,VSTRIP
C            XSTRIP,RCLOS,RWAIT,RWRIT,VRFPLT
C
C     CALLED BY:  USER,AXIS,CARC,CONVEX,CURVE,DASHLN,ELLIPS,LINE,
C                RECT,SYMBOL,XCIRCL,XTEXT
C
C     COMMON USED:
C     /DVCOM/
C            L DASHPN  - .TRUE. IFF THE CURRENT PEN IS DEFINED AS
C                        AN ON-OFF-ON-OFF PATTERN
C            I IAUTXT()- ARRAY TO HOLD AUTHOR TEXT STRING
C            I ICXPTS  - MAXIMUM NUMBER OF POLYGON ELEMENTS ALLOWED
C            I IEOJ    - END-OF-JOB IPEN CODE
C            I IEOP()  - END-OF-PLOT IPEN CODE
C            I IHBUF() - VERSATEC DATA STANDARD HEADER WORDS
C            I ILWP    - (LINE WIDTH - 1)/2
C            I ILWM    - LINE WIDTH/2
C            I IOPEN   - SUBROUTINE PLOTS FIRST CALL FLAG
C            I ISORT   - PHASE II SORT FLAG SET BY SUBROUTINE PLOT
C                        = 0 - NO PARTITIONING REQUIRED
C                        = 1 - REP PARTITIONING REQUIRED
C                        = 2 - RPM PARTITIONING REQUIRED
C                        = 3 - REP AND RPM PARTITIONING REQUIRED
C            I IX1,IX2
C              IY1,IY2 - WORKING STORAGE FOR CURRENT VECTOR
C            I MAXPAT  - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE
C            I MSB     - WORD TO SET HIGH ORDER BIT DETERMINED BY
C                        PRECISION (16/32) SELECTED.
C            I NCH     - NUMBER OF CHARACTERS IN AUTHOR TEXT STRING
C            I NCLIP   - NUMBER OF CLIPPED VECTORS
C            I NPAT()  - NPAT(I) IS THE NUMBER OF WORDS IN TONE
C                        PATTERN #I
C            I NPLOT   - NUMBER OF CURRENT PLOT
C            L PMOVE   - STATUS OF LAST PLOT CALL (.TRUE.=MOVE)
C            R RORG()  - AN X,Y PAIR WHICH DEFINES THE CURRENT
C                        SOFTWARE ORIGIN. SET BY REORIGIN CALL
C                       TO *PLOT*
C            L ROT90   - IF ROT90 = .TRUE. THEN ROTATE THE PLOT
C                        COUNTERCLOCKWISE 90 DEGREES
C            R VCP()   - CURRENT POINT IN COMPUTATIONAL COORDINATES
C            L VSFLAG  - .TRUE. IFF STRIPPING IN THE Y-DIRECTION
C                        IS NECESSARY
C            I VSMAX   - MAXIMUM Y-VALUE FOR A STRIPPED VECTOR
C            R WIN()   - THE CURRENT VIEW WINDOW IN COMPUTATIONAL
C                        COORDINATES
C            R WTV()   - WINDOW TRANSFORMATION VARIABLES. USED TO
C                        TRANSFORM COORDINATES FROM THE VIEW WINDOW
C                        SYSTEM TO THE  VIEWPORT SYSTEM
C            R XFAC    - SCALING FACTOR SET BY *OFFSET* AND USED BY
C                        *PLOT* FOR SCALED/OFFSET MOVES
C            L XMAJOR  - INDICATES IF XMAJOR MOVE VECTOR
C            R XOFF    - USED BY *OFFSET* AND *PLOT* IN DEFINING
C                        SCALED/OFFSET MOVES
C            R YFAC    - SCALING FACTOR SET BY *OFFSET* AND USED BY
C                        *PLOT* FOR SCALED/OFFSET MOVES
C            I YNIPS   - NIBS PER SCAN
C            R YOFF    - USED BY *OFFSET* AND *PLOT* IN DEFINING
C                        SCALED/OFFSET MOVES.
C
C     /PRMCOM/
C            I IBYTES  - DEFAULT PLOTTER BYTES/SCAN (8-BIT BYTES).
C            I IDISK   - CONTROLLER WITH DISK FLAG.
C                       = 0 - NO DISK [DEFAULT]
C                       = 1 - DISK INSTALLED IN REP CONTROLLER
C                       = 2 - DISK INSTALLED IN RPM CONTROLLER
C                       = 3 - DISK INSTALLED IN BOTH REP AND
C                             RPM CONTROLLER
C            I IRDT    - RASTER DATA TRANSLATE FLAG. FOR EITHER
C                       100/200 OR 200/400 DOT SELECTION. NOT
C                       SUPPORTED ON ALL VERSATEC MODELS.
C                       = 0 - NO RASTER DATA TRANSLATE [DEFAULT]
C                       # 0 - RASTER DATA TRANSLATE
C            I IFFAP   - INDICATES WHETHER A FORM FEED OR SPACE
C                       AFTER EACH PLOT IS DESIRED.
C                       <  0 - FORM FEED AFTER PLOT
C                       >= 0 - SPACE AFTER EACH PLOT (IN UNITS)
C                         [DEFAULT = 0]
C            I INHNCE  - LINE ENHANCE FLAG. NOT SUPPORTED ON ALL
C                       VERSATEC MODELS.
C                       = 0 - NO LINE ENHANCEMENT [DEFAULT]
C                       # 0 - LINE ENHANCEMENT
C            I INITFF  - INITIAL FORM FEED FLAG.
C                       = 0 - NO INITIAL FORM FEED [DEFAULT]
C                       # 0 - OUTPUT INITIAL FORM FEED
C            I INVERS  - INVERSE IMAGE PLOTTING FLAG. NOT SUPPORTED
C                       ON ALL VERSATEC MODELS.
C                       = 0 - NO INVERSE IMAGE PLOTTING [DEFAULT]
C                       # 0 - INVERSE IMAGE PLOTTING
C            I IPRISM()- CONTROLLER CONTROL ARRAY
C            I ISFLAG  - PLOTTER SPEED CHANGE FLAG.
C                       = 0 - NO SPEED CONTROL OUTPUT [DEFAULT]
C                       # 0 - OUTPUT SPEED CONTROL COMMAND
C            I ISPACE  - SPACE BETWEEN COPIES OF PLOTS.
C                       >= 0 - SPACE BETWEEN COPIES
C                         [DEFAULT= 2 * (RDEN/UNITS)]
C                       = -1 - FORM FEED BETWEEN COPIES
C            I ISPEED  - PLOTTER OUTPUT SPEED. NOT SUPPORTED ON
C                       ALL PLOTTERS.
C                       = -1 - FULL SPEED [DEFAULT]
C                       =  0 - .125 IPS
C                       =  1 - .250 IPS
C                       =  2 - .500 IPS
C                       =  3 - .750 IPS
C                       =  4 - 1.00 IPS
C            I KDISK   - RPM DISK USE FLAG
C                       = 0 - OVERFLOW ELEMENTS TO DISK IF
C                            MEMORY CAPACITY EXCEEDED
C                       = 1 - RASTER TO DISK ONLY IF MEMORY EXCEEDED
C                       = 2 - RASTER TO DISK
C            I KREP    - TARGET OUTPUT CONTROLLER
C                       = 0 - UNKNOWN
C                        = 1 - REP CONTROLLER
C                        = 4 - RPM CONTROLLER
C            I KTWO    - REP/RPM CONFIGURATION FLAG
C                       = 0 - ONLY ONE TYPE OF CONTROLLER AVAILABLE
C                       # 0 - REP & RPM SERIES CONTROLLER AVAILABLE
C            I LASTFF  - LAST FORM FEED FLAG.
C                       = 0 - NO FORM FEED AFTER THE LAST PLOT
C                       # 0 - FORM FEED AFTER THE LAST PLOT
C            I MIRROR  - MIRROR IMAGE PLOTTING FLAG. NOT
C                       SUPPORTED ON ALL VERSATEC MODELS.
C                       = 0 - NO MIRROR IMAGE PLOTTING [DEFAULT]
C                       # 0 - MIRROR IMAGE PLOTTING
C            I MODE1   - INVOKE VRF OUTPUT FLAG
C                       = 0 - DO NOT INVOKE VRF OUTPUT
C                       = 1 - INVOKE VRF OUTPUT AT END-OF-JOB
C                       = 2 - INVOKE VRF OUTPUT AT END-OF-PLOT
C            I MUXOUT  - OUTPUT MULTIPLEXER PORT NUMBER
C                       = 0 - NO OUTPUT MULTIPLEXER [DEFAULT]
C                       = 1 - OUTPUT TO PORT #1
C                       = 2 - OUTPUT TO PORT #2
C                       = 3 - OUTPUT TO PORTS #1 AND #2
C            R PMSIZE  - RPM CONTROLLER MEMORY SIZE IN MEGABYTES
C            R RDEN    - DEFAULT PLOTTER NIBS/INCH VALUE.
C            R UNITS   - DEFAULT UNITS MEASURE EXPRESSED
C                       IN UNITS/INCH.
C     /VRFCOM/
C            R BYTKNT()- BYTE COUNT FOR EACH COLOR
C            R DRWELM  - ELEMENT COUNT FOR A DRAW COMMAND
C            R DRWKNT  - BYTE COUNT FOR A DRAW COMMAND
C            R RMXELM  - MAXIMUM ELEMENT COUNT FOR BANDING
C            I IBXMAX  - MAXIMUM X VALUE (USED FOR BANDING)
C            I ICOPY   - PHASE II PLOT COPY COUNT
C            I IREC()  - CURRENT RECORD POINTER
C            I NREC    - NEXT RECORD POINTER
C            I NHEAD   - POINTER TO NEXT FRAME HEADER BLOCK
C            R VRFKNT()- COUNTER FOR RANDOM ELEMENTS
C            I IBEGIN()- THE INDEX POINTER INTO THE OBUF ARRAY
C                        OF THE START OF THE CURRENT VRF OUTPUT
C                        BUFFER
C            I ICOMD() - INTEGER ARRAY TO HOLD 16/32 BIT VRF
C                        COMMANDS, INITIALIZED IN PLOTS
C            I IOCODE()- THE OUTCODES FOR THE STARTING AND
C                        ENDING POINTS OF A VECTOR
C            I MAX()   - THE END OF BUFFER POINTER OF THE
C                        CURRENT VRF OUTPUT BUFFER
C            I NEXTO() - CURRENT OUTPUT POINTER FOR THE VRF
C                        OUTPUT BUFFER
C            R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT
C                       OBJKNT(1) - VECTORS
C                       OBJKNT(2) - POLYGONS
C                       OBJKNT(3) - CIRCLES
C                       OBJKNT(4) - CHARACTERS
C            I OBUF()  - ARRAY FOR VRF OUTPUT BUFFERS (LREC*5)
C            I PRECIS  - COORDINATE PRECISION FOR THE VRF
C                        OUTPUT FILE (16 OR 32-BIT PRECISION)
C            R VRFMAX  - MAXIMUM ELEMENT COUNT FOR UNPARTITIONED
C                        PLOT
C     /IOCOM/
C            I LREC    - LENGTH OF DATA FILE RECORD IN WORDS
C
C     /MSGCOM/
C            I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS
C            R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS
C
C       /CLRCOM/
C               I IDASRT()- POINTER TO FIRST DATA RECORD IN A BAND
C            I ITNSEQ()- TONING SEQUENCE FOR OUTPUT
C            I IVCFLG  - FLAG TO INDICATE COLOR MODE SET
C            I NCPASS  - NUMBER OF COLOR PASSES
C     /KLCOM/
C            L KFLAG   - FLAG INDICATING REP OUTPUT AND .GT. 13.65'
C                        PLOTTING REQUIRED.
C            I KSIZE   - VARIABLE DEFINING 13.65' IN SCANS, USED TO
C                        DETERMINE IF ELEMENT CROSSES A 13.65' PAGE
C                        BOUNDARY.
C
C     LOCAL:
C            I IBND     - INDEX TO CURRENT COLOR PARTITION
C            I IBYTS    - BYTES REMAINING IN OUTPUT BUFFER
C            I IC200    - FORM-FEED COMMAND
C            I ICAREC   - SAVE POINTER TO CONTROL ARRAY
C            I ICC04    - PRINT PASS-ALL COMMAND
C            I ICPCMD   - COPY COMMAND FLAG WORD
C            I IDTBND   - CURRENT PARTITION INDEX
C            I IEVRF    - END-VRF COMMAND
C            I I,IA,IB, - INDEX FOR LOOPS
C              J
C            I IP       - ABSOLUTE VALUE OF THE IPEN FUNCTION CODE
C            I IPLMAX   - MAXIMUM X VALUE ALLOWED FOR PLOT + SPACE
C            I IPAGE1,  - 13.65' PAGE INDEX
C              IPAGE2
C            I IRECP    - TEMP I*4 VARIABLE FOR EQU TO 2 16 BIT VAL
C            I IRECT()  - TEMP I*2 VARIABLE FOR EQU TO 32 BIT VALUE
C            I IREW     - PLOTTER REWIND COMMAND
C            I ISKIP    - SKIP COMMAND TO FILL OUTPUT BUFFER
C            I ISKIP0   - INITIAL SKIP COMMAND
C            I ISPFF    - SPACE/FORM-FEED FLAG
C            I ISTAT    - STATUS OF THE CLIPPING OPERATION
C            I JDISK()  - RPM DISK CONTROL FLAGS
C            I JFLAG    - DISK/MULTI-COPY FLAG
C            I KSORT()  - SORT FLAGS
C            I NDLTX    - DELTA X (IX2-IX1) VALUE
C            I NDTBND   - NUMBER OF PARTITIONS WITH ELEMENTS
C            I NTNSEQ() - TEMP STORAGE FOR ITNSEQ()
C            I NUMPAT   - NUMBER OF PATTERNS DEFINED
C            R PATSIZ   - BYTES OF RPM MEMORY REQUIRED FOR PATTERNS
C            L PENUP    - PROCESSING FLAG: PEN UP/DOWN
C            R PSIZE    - RPM MEMORY SIZE IN BYTES
C            R TMP      - TEMPORARY VARIABLE
C            R VEC()    - WORKING VECTOR
C            R XX,YY    - CURRENT POINT IN WINDOW COORDINATES
C            R WCP()    - SAVE CURRENT POINT IN WINDOW COORDINATES
C
C
C
      LOGICAL PENUP
C
C
      LOGICAL ROT90,PMOVE,IPDEF,DASHPN,XMAJOR,VSFLAG
      INTEGER PWIDTH,XNIPS,YNIPS,PENPAT,VSMAX,PFONT
C...  COMMON /DVCOM/  PHASE I COMMON VARIABLES
C
      COMMON /DVCOM/
     *         ANC,    DASHPN, FACT,   HTC,    ICUT,   ICWTV,  ICXPTS,
     *         IEOJ,   ILWM,   ILWP,   IOPEN,  ISORT,  ITFLAG, IX1,
     *         IX2,    IY1,    IY2,    JFONT,  JPEN,   KPAT,   KWIDTH,
     *         LASTX,  LASTY,  MAXPAT, MSB,    MSKALL, NCH,    NCLIP,
     *         NIBSX,  NLPAT,  NPLOT,  PFONT,  PMOVE,  PXMIN,  PXMAX,
     *         PYMIN,  PYMAX,  RADN,   ROT90,  SXC,    SYC,    TSINA,
     *         TCOSA,  XDEN,   XFAC,   XNIPS,  XOFF,   YDEN,   YFAC,
     *         YOFF,   YNIPS,  VSFLAG, VSMAX,  XMAJOR,
     *         IPAT(16,256), IEOP(4),  IHBUF(2), IPDEF(64),
     *         NPAT(255),    PENPAT(4,64), PWIDTH(64),
     *         RORG(2), VCP(2), VP(4), WIN(4), WTV(4), WX(4),  WY(4),
     *         IAUTXT(15)
C
C
C
C...  COMMON /PRMCOM/ - DEFAULT PLOTTING PARAMETERS
C
      INTEGER PENTBL,BMODEL,BBYTES,CMODEL,CBYTES
      LOGICAL VSTRP
      COMMON /PRMCOM/
     *    IBYTES,      IDISK,       IFFAP,       LASTFF,
     *    IJPEN,       INHNCE,      INITFF,      INVERS,
     *    IRDT,        ISPACE,      ISPEED,      ISFLAG,
     *    IUSER,       JBYTES(75),  KREP,        IFONT,
     *    MIRROR,      MODEL,       MODL(75),    MXPEN,
     *    NCOPY,       NMODL,       PENTBL(64,2), RDEN,
     *    RDENS(75),   SCALE,       UNITS,       XFACT,
     *    YFACT,       XSTART,      YSTART,
     *    VXMIN,       VXMAX,       VYMIN,       VYMAX,
     *    WXMIN,       WXMAX,       WYMIN,       WYMAX,
     *    BMODEL,      BDEN,        BBYTES,
     *    CMODEL,      CDEN,        CBYTES,
     *    IDEFLG(256), IUCLR,       MODE1,       IPRISM(61),
     *    MUXOUT,      PMSIZE,      MAXPEN,      KTWO,
     *         LTNFLG,      LTNCLR,      MTAPE,       VSTRP,
     *         JSORT,       JCPCMD,      JCUT,        KDISK
C
C...  COMMON /VRFCOM/ - VRF COMMON VARIABLES
C
      INTEGER PRECIS
      INTEGER OBUF
      COMMON /VRFCOM/
     *    DRWELM,    DRWMAX,    DRWMIN,    DRWKNT,    ICOPY,
     *         ICNSTX,    IBXMAX,    IHDCNT,    MIN,
     *         NBYTS,     NCHUNK,    NHEAD,     NREC,      PRECIS,
     *         RMXELM,    VRFMAX,
     *         BYTKNT(4), IBEGIN(4), ICOMD(2),  IOCODE(2), IREC(4),
     *         MAX(4),    NEXTO(4),  OBJKNT(4), VRFKNT(4), OBUF(640)
C
C...  COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES
C
      COMMON /IOCOM/
     *    IUNIT, LUNIT, LREC, IOTYPE
C
C...  COMMON /MSGCOM/ - MESSAGE OUTPUT VARIABLES
C
      COMMON /MSGCOM/ INTARG(8), RELARG(12)
C
C
C...  COMMON /CLRCOM/ - COLOR VARIABLES
C
      INTEGER PCOLOR, CURPEN
      LOGICAL PENCHG
      COMMON /CLRCOM/
     *    ICLMAX,  ITNCLR,  ITNFLG,  IVCFLG,  NCPASS,  PENCHG,
     *         CURPEN(4), ICLRDF(4,512), IDASRT(4), ITNSEQ(4),
     *         PCOLOR(64)
C
C...  COMMON /KLCOM/ - X STRIPPING VARIABLES
C
      LOGICAL KFLAG
      COMMON /KLCOM/ KFLAG, KSIZE
C
      DIMENSION WCP(2), VEC(4), NTNSEQ(4), KSORT(4), JDISK(4)
C
C
C...  DEFINE END-VRF('8000'X),FORM-FEED('C200'X),SKIP('C000'X)
      DATA IEVRF/32768/,IC200/49664/,ISKIP0/49152/
C
C...    DEFINE PASS-ALL COMMAND('CC04'X),REWIND-COMMAND('9B57'X),
C     PAPER-CUT COMMAND('9B4B'X), AND SET-PEN COMMAND('8301'X)
      DATA ICC04/52228/,IREW/39767/,ICUTP/39755/,ISETPN/33537/
C
C
C     *******************************
C     * DECODE IPEN SPECIFICATION *
C     *******************************
C
      XX = X
      YY = Y
      IP = IABS(IPEN)
C-D
C...  CALL TO BE PRINTED?
C     RELARG(1)=XX
C     RELARG(2)=YY
C     INTARG(1)=IPEN
C     CALL MSGLG1(35)
C-D
C
C...  PEN DOWN MOVE?
      IF (IP.NE.2) GO TO 100
         PENUP = .FALSE.
         GO TO 220
C
C...  PEN UP MOVE?
  100 IF (IP.NE.3) GO TO 120
         PENUP = .TRUE.
         GO TO 220
C
C...  PEN DOWN OFFSET/SCALED?
  120 IF (IP.NE.12) GO TO 140
         PENUP = .FALSE.
         GO TO 200
C
C...  PEN UP OFFSET/SCALED?
  140 IF (IP.NE.13) GO TO 160
         PENUP = .TRUE.
         GO TO 200
C
C...  END OF JOB?
  160 IF (IPEN .EQ. IEOJ)  GO TO 740
C
C...  CHECK END-OF-PLOT CODE
      DO 180 I = 1,4
         IF (IEOP(I) .EQ. IPEN)  GO TO 740
  180 CONTINUE
C-I
C...     OUTPUT UNDEFINED CALL MESSAGE
         INTARG(1)=IPEN
         CALL MSGLG1(36)
         GO TO 1380
C-I
C
C...  SCALE/OFFSET  COORDINATES
  200 XX = (XX - XOFF)/XFAC
      YY = (YY - YOFF)/YFAC
C
C...  TRANSLATE TO ACCOUNT FOR REORIGIN
C     SPECIAL *PLOT* CALLS ALLOW THE USER TO RESPECIFY THE SOFTWARE
C     PLOTTING ORIGIN.  USER COORDINATES, WHICH ARE SPECIFIED RELATIVE
C     TO THE DYNAMIC SOFTWARE ORIGIN MUST BE TRANSLATED INTO THE WINDOW
C     COORDINATE SYSTEM.
  220 XX = XX + RORG(1)
      YY = YY + RORG(2)
C
C...  SAVE CURRENT POSITION IN WINDOW SYSTEM
      WCP(1) = XX
      WCP(2) = YY
C
C...  ROTATE COORDINATES IF NECESSARY
C     IF THE PLOT IS BEING ROTATED, THEN THE VIEW WINDOW AND ALL
C     EXCLUSIVE CLIPPING WINDOWS ARE PRE-ROTATED.  VECTORS MUST BE
C     TRANSFORMED TO THE ROTATED WINDOW COORDINATE SYSTEM.
      IF (.NOT. ROT90) GO TO 240
         TMP = XX
         XX = -YY
         YY = TMP
  240 IF (.NOT. PENUP)  GO TO 260
C
C...  INDICATE PENUP CALL
      PMOVE = .TRUE.
      GO TO 720
C
C...  PROCESS PENDOWN CALL
  260 VEC(1) = VCP(1)
      VEC(2) = VCP(2)
      VEC(3) = XX
      VEC(4) = YY
C
C...  COMPUTE OUT CODES FOR ENDPOINTS
C     OUT CODES ARE CODES THAT SUMMARIZE THE POSITION OF A POINT IN
C     RELATION TO A RECTAGULAR WINDOW AREA.
C
C...  CHECK FIRST END-POINT
      IOCODE(1) = 0
      IF (VEC(1) .GE. WIN(1))  GO TO 280
      IOCODE(1) = 1
      GO TO 300
  280 IF (VEC(1) .LE. WIN(3))  GO TO 300
      IOCODE(1) = 2
  300 IF (VEC(2) .GE. WIN(2))  GO TO 320
      IOCODE(1) = IOCODE(1) + 4
      GO TO 340
  320 IF (VEC(2) .LE. WIN(4))  GO TO 340
      IOCODE(1) = IOCODE(1) + 8
C
C...  CHECK END-POINT
  340 IOCODE(2) = 0
      IF (VEC(3) .GE. WIN(1))  GO TO 360
      IOCODE(2) = 1
      GO TO 380
  360 IF (VEC(3) .LE. WIN(3))  GO TO 380
      IOCODE(2) = 2
  380 IF (VEC(4) .GE. WIN(2))  GO TO 400
      IOCODE(2) = IOCODE(2) + 4
      GO TO 420
  400 IF (VEC(4) .LE. WIN(4))  GO TO 420
      IOCODE(2) = IOCODE(2) + 8
C
C...  TEST FOR TRIVIAL ACCEPTANCE OF VECTOR
C     IF BOTH ENDPOINTS ARE INSIDE OF THE VIEW WINDOW, THEN THE VECTOR
C     IS COMPLETELY VISIBLE AND DOESN'T NEED TO BE CLIPPED.
C-D
C...  CHANGE 'GO TO 500' TO 'GO TO 480' IF DEBUG MESSAGE #5 IS ENABLED
C-D
  420 IF (IOCODE(1) + IOCODE(2) .EQ. 0)  GO TO 500
C
C...  IF THE FIRST ENDPOINT OF THE VECTOR IS OUTSIDE THE CLIPPING
C     WINDOW WE MUST SET PMOVE TO TRUE SO THAT A MOVE IS OUTPUT
C     TO THE CONTROLLER.
      IF (IOCODE(1) .NE. 0) PMOVE = .TRUE.
C
C...  TEST FOR TRIVIAL REJECTION OF VECTOR
C     A VECTOR CAN BE REJECTED WITHOUT FURTHER TESTING IF ONE OF THE
C     FOLLOWING CONDITIONS IS TRUE:
C
C     A) BOTH ENDPOINTS ARE ABOVE THE TOP EDGE OF THE VIEW WINDOW
C     B) BOTH ENDPOINTS ARE BELOW THE BOTTOM EDGE OF THE VIEW WINDOW
C     C) BOTH ENDPOINTS ARE LEFT OF THE LEFT EDGE OF THE VIEW WINDOW
C     D) BOTH ENDPOINTS ARE RIGHT OF THE RIGHT EDGE OF THE VIEW WINDOW
C
C     IF 'AND'ING THE OUT CODES FOR TWO POINTS PRODUCES A NON-ZERO
C     RESULT, THEN ONE OF THE ABOVE CONDITIONS IS TRUE AND THE VECTOR
C     CAN BE REJECTED WITHOUT FURTHER TESTING.  THIS IS SO BECAUSE EACH
C     OF THE FOUR BITS OF THE OUT CODE REPRESENTS THE RELATIONSHIP OF
C     THE POINT TO ONE OF THE WINDOW EDGES.  A ZERO BIT INDICATES THAT
C     THE PT. IS ON THE VISIBLE SIDE OF THE CORRESPONDING WINDOW EDGE.
C     A ONE BIT INDICATES THAT THE POINT IS ON THE INVISIBLE SIDE OF
C     THE CORRESPONDING EDGE.  THE OUTCODES FOR TWO PTS. CAN ONLY HAVE
C     THE SAME BIT SET IF BOTH POINTS ARE ON THE INVISIBLE SIDE OF THE
C     SAME WINDOW EDGE.  THIS MEANS THAT ONE OF THE CONDITIONS A-D IS
C     TRUE.
      IF (AND(IOCODE(1),IOCODE(2)) .NE. 0) GO TO 440
C
C...  VECTOR MUST BE CLIPPED TO THE VIEW WINDOW
C     *CLIP* RETURNS THE PORTION OF A VECTOR WHICH IS INSIDE THE SPEC-
C     IFIED WINDOW AND THE STATUS OF THE CLIPPING OPERATION.
      CALL CLIP (VEC(1), ISTAT)
C
C...  TEST FOR REJECTION OF VECTOR
      IF (ISTAT .NE. 4) GO TO 460
C
C...     UNPLOTTABLE VECTOR TO BE PRINTED?
C        IF THE CLIPPED VECTOR'S STATUS = 4, THEN THE VECTOR IS
C        INVISIBLE AND CAN BE REJECTED.
  440 CONTINUE
C-D
C...  OUTPUT UNPLOTTABLE VECTOR MESSAGE
C       RELARG(1)=VEC(1)
C       RELARG(2)=VEC(2)
C       RELARG(3)=VEC(3)
C       RELARG(4)=VEC(4)
C       RELARG(5)=WIN(1)
C       RELARG(6)=WIN(2)
C       RELARG(7)=WIN(3)
C       RELARG(8)=WIN(4)
C       RELARG(9)=RORG(1)
C       RELARG(10)=RORG(2)
C       CALL MSGLG1(37)
C-D
      NCLIP = NCLIP + 1
C
C...  CHANGE CALL TO MOVE
      PMOVE = .TRUE.
      GO TO 720
C
C...  INCREMENT CLIPPING OPERATION COUNTER
  460 NCLIP = NCLIP + 1
C-D
C...  OUTPUT CLIPPED VECTOR MESSAGE
C       RELARG(1)=VEC(1)
C       RELARG(2)=VEC(2)
C       RELARG(3)=VEC(3)
C       RELARG(4)=VEC(4)
C       RELARG(5)=WIN(1)
C       RELARG(6)=WIN(2)
C       RELARG(7)=WIN(3)
C       RELARG(8)=WIN(4)
C       RELARG(9)=RORG(1)
C       RELARG(10)=RORG(2)
C       CALL MSGLG1(38)
C-D
      GO TO 500
C
C 480 CONTINUE
C-D
C...  OUTPUT PLOTTABLE VECTOR MESSAGE
C       RELARG(1)=VEC(1)
C       RELARG(2)=VEC(2)
C       RELARG(3)=VEC(3)
C       RELARG(4)=VEC(4)
C       RELARG(5)=WIN(1)
C       RELARG(6)=WIN(2)
C       RELARG(7)=WIN(3)
C       RELARG(8)=WIN(4)
C       RELARG(9)=RORG(1)
C       RELARG(10)=RORG(2)
C       CALL MSGLG1(39)
C-D
C
C     ********************************************************
C     * PLOTTABLE VECTOR: <VEC(1),VEC(2)> TO <VEC(3),VEC(4)> *
C     ********************************************************
C
C...  TRANSFORM COORDINATES FROM WINDOW TO VIEWPORT SYSTEM
C
C...  CHECK IF PREVIOUS POINT NEEDS TO BE COMPUTED
  500 IF (PMOVE)  GO TO 520
         IX1 = LASTX
         IY1 = LASTY
         GO TO 540
  520    IX1 = VEC(1)*WTV(1) + WTV(2)
         IY1 = VEC(2)*WTV(3) + WTV(4)
  540 IX2 = VEC(3)*WTV(1) + WTV(2)
      IY2 = VEC(4)*WTV(3) + WTV(4)
      LASTX = IX2
      LASTY = IY2
C
C...  DETERMINE IF THIS IS AN X-MAJOR MOVE
      XMAJOR = .FALSE.
      IF (IABS(IX2-IX1) .GE. IABS(IY2-IY1)) XMAJOR = .TRUE.
C
C...  CHECK FOR A DEFINED PEN THAT MUST BE STROKED OUT
      IF (.NOT. DASHPN) GO TO 560
      IF (IX1 .EQ. IX2 .AND. IY1 .EQ. IY2) GO TO 560
         CALL DRWPEN
         GO TO 720
C
C...  CHECK IF STRIPPING IN THE Y-DIRECTION IS NECESSARY
  560 IF (.NOT. VSFLAG) GO TO 620
      IF (XMAJOR) GO TO 580
         IF (IY1 .LT. YNIPS .AND. IY2 .LT. YNIPS) GO TO 620
         GO TO 600
  580    IF ((IY1+ILWP).LT.YNIPS .AND. (IY2+ILWP).LT.YNIPS) GO TO 620
  600    CALL VSTRIP
         GO TO 720
C
  620 CONTINUE
C
C...  CHECK IF STRIPPING IN THE X-DIRECTION IS NECESSARY
      IF (.NOT. KFLAG) GO TO 700
C
C...  CHECK IF THE VECTOR IS LONGER THAN KSIZE
      NDLTX = IABS(IX2-IX1)
      IF (NDLTX .GE. KSIZE) GO TO 680
C
C...  IF PRISM, STRIPPING NOT NECESSARY
      IF (KREP .EQ. 4) GO TO 700
C
C...  CHECK IF THE VECTOR CROSSES A PAGE BOUNDARY
      IF (.NOT. XMAJOR) GO TO 630
          IPAGE1 = (IX1+8)/KSIZE
          IPAGE2 = (IX2+8)/KSIZE
          GO TO 660
  630 IF (IX1 .GT. IX2) GO TO 640
          IPAGE1 = (IX1+8-ILWM)/KSIZE
          IPAGE2 = (IX2+8+ILWP)/KSIZE
          GO TO 660
  640     IPAGE1 = (IX2+8-ILWM)/KSIZE
          IPAGE2 = (IX1+8+ILWP)/KSIZE
  660 IF (IPAGE1 .EQ. IPAGE2) GO TO 700
C
  680    CALL XSTRIP
         GO TO 720
C
  700 CONTINUE
      CALL OUTVEC
C
C
C...  THE CURRENT PEN LOCATION IS UPDATED TO THE POINT SPECIFIED
C     IN THE *PLOT* CALL AFTER IT HAS BEEN TRANSFORMED TO THE WINDOW
C     COORDINATE SYSTEM BUT BEFORE IT HAS BEEN CLIPPED.
  720 VCP(1) = XX
      VCP(2) = YY
C
C
C     *****************************
C     * EXAMINE SPECIAL FUNCTIONS *
C     *****************************
C
C...  TEST FOR RE-ORIGIN SPECIFICATION
      IF (IPEN .GE. 0)  RETURN
C
C
C     ******************
C     * RE-ORIGIN CALL *
C     ******************
C
C-D
C...  OUTPUT RE-ORGIN MESSAGE
C       RELARG(1)=RORG(1)
C       RELARG(2)=RORG(2)
C       RELARG(3)=WIN(1)
C       RELARG(4)=WIN(2)
C       RELARG(5)=WIN(3)
C       RELARG(6)=WIN(4)
C       CALL MSGLG1(40)
C-D
C
C     THE SOFTWARE ORIGIN IS SET TO THE CURRENT POSITION.
      RORG(1) = WCP(1)
      RORG(2) = WCP(2)
C
C...  RE-ORIGIN TO BE PRINTED?
C-D
C...  OUTPUT RE-ORGIN MESSAGE
C       RELARG(1)=RORG(1)
C       RELARG(2)=RORG(2)
C       RELARG(3)=WIN(1)
C       RELARG(4)=WIN(2)
C       RELARG(5)=WIN(3)
C       RELARG(6)=WIN(4)
C       CALL MSGLG1(40)
C-D
      RETURN
C
C
C     ********************
C     * END OF PLOT CALL *
C     ********************
  740 KPEN = IPEN
      IF (MODE1 .EQ. 2) KPEN = IEOJ
C
C     SEE IF ANY ELEMENTS WERE MADE IN LAST PLOT
C     SAVE ITNSEQ() AND SET TO POSITIVE NUMBER
C     SEE HOW MANY PARTITIONS HAVE ELEMENTS IN THEM
C
        NDTBND = 0
      DO 760 IBND = 1,NCPASS,1
         NTNSEQ(IBND) = ITNSEQ(IBND)
         ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
         IF (VRFKNT(IBND) .GT. 0.0)  NDTBND = NDTBND + 1
  760   CONTINUE
C
C...    IF NDTBND = 0 AND NO ELEMENTS CLIPPED THEN NULL PLOT
      IF (NDTBND .EQ. 0 .AND. NCLIP .EQ. 0) GO TO 1260
C-I
C...  OUTPUT PLOT SUMMARY MESSAGES
      INTARG(1)=NPLOT
      INTARG(2)=NCLIP
      CALL MSGLG1(42)
C
C...  IF NDTBND = 0, ALL ELEMENTS CLIPPED - IGNORE PLOT
      IF (NDTBND .EQ. 0) GO TO 1260
C
C...  OUTPUT OBJECT COUNT MESSAGES
      DO 765 J = 1,4
          RELARG(1) = OBJKNT(J)
          IF (RELARG(1) .NE. 0.0) CALL MSGLG1(111+J)
  765 CONTINUE
C-I
C
C...  GET TOTAL LENGTH OF TONE PATTERNS, ADJUST PRISM MEMORY SIZE
      ITEMP = 0
      DO 770 I = 1,MAXPAT
         ITEMP = ITEMP + NPAT(I)
  770 CONTINUE
      PATSIZ = 2.0 * ITEMP
C
C...  CALCULATE PRISM MEMORY CAPACITY
      PSIZE = PMSIZE * 1048576.0
      PMCAP = 0.0
      IF (KREP .EQ. 1 .AND. KTWO .EQ. 0)  GO TO 775
C
C...  DETERMINE LENGTH OF PLOT
      MAXXR = IBXMAX + 1
      IF (IVCFLG .NE. 0)  GO TO 773
      ISPFF = ISPACE
      IF (NCOPY .EQ. 1 .OR. IFFAP .GT. ISPACE) ISPFF = IFFAP
      IF (ISPFF .LE. 0)  GO TO 773
      IPLMAX = 32759
      IF (KREP .EQ. 4) IPLMAX = 32767
      IF (PRECIS .EQ. 32) IPLMAX = 2147483647
      I = ISPFF * INT(RDEN/UNITS)
      J = IPLMAX - IBXMAX
      IF (J .LE. 0) GO TO 773
      IF (I .GT. J) I = J
      MAXXR = IBXMAX + I + 1
  773 PMCAP = RPMCAP (IBYTES,MAXXR,0,PSIZE)
  775 CONTINUE
C
C...  SET COPY COUNT TO ONE IF 430 MAG TAPE OUTPUT
      IF (MTAPE .EQ. 1)  ICOPY = 1
C
C...  SET COPY COMMAND FLAG
      ICPCMD = JCPCMD
      IF (ICOPY .EQ. 1) ICPCMD = 0
C
C...  CHECK IF COPY COMMAND CAN BE USED WITH THE REP
      IF (KREP.EQ.1 .AND. IDISK.NE.1 .AND. IDISK.NE.3) ICPCMD = 0
C
C...  OUTPUT BYTE COUNT MESSAGE AND SET SORT FLAGS
      CALL MSGLG1(116)
      DO 900 IBND = 1,NCPASS
C
C...      ADD PATTERN BYTE COUNT TO TOTAL BYTE COUNT
          BYTKNT(IBND) = BYTKNT(IBND) + PATSIZ
C
C...      OUTPUT MESSAGE
          RELARG(1) = BYTKNT(IBND)
          RELARG(2) = VRFKNT(IBND)
          IA = IABS(ITNSEQ(IBND))
          IF (VRFKNT(IBND) .GT. 0.0) CALL MSGLG1(116+IA)
C
C...      NOW CHECK IF PLOT REQUIRES PARTITIONING
          KSORT(IBND) = 0
C
C...      CHECK IF SORTING REQUIRED FOR A REP
          IF (KREP .EQ. 1 .AND. (JSORT .EQ. 1 .OR. (JSORT .EQ. 2
     *              .AND. MTAPE .NE. 1 .AND. IDISK .NE. 1 .AND.
     *              IDISK .NE. 3 .AND. VRFKNT(IBND) .GT. VRFMAX)))
     *           KSORT(IBND) = 1
C
C...      DETERMINE RPM DISK CONTROL FLAG.
C         IF USER SET PRISM CONTROL ARRAY, USE THAT VALUE.
C         OTHERWISE, IF THERE IS A PRISM WITH A DISK, SET THE
C         FLAG BASED ON THE DISK CONTROL FLAG AND WHETHER THE
C         PLOT EXCEEDS THE MEMORY CAPACITY.
C         NOTE: THIS FLAG, NOT THE DISK FLAG, IS USED
C              TO DETERMINE WHETHER SORTING IS NEEDED FOR THE RPM
          JDISK(IBND) = IPRISM(15)
          IF (KREP .EQ. 1 .AND. KTWO .EQ. 0)  GO TO 895
          IF ( (JDISK(IBND) .NE. -1)
     *               .OR. (IDISK .EQ. 0 .OR. IDISK .EQ. 1))  GO TO 880
          IF ( (KDISK .EQ. 1 .AND. BYTKNT(IBND) .GT. PMCAP)
     *               .OR. KDISK .EQ. 2)  JDISK(IBND) = 2
          IF ( KDISK .EQ. 0 .AND. BYTKNT(IBND) .GT. PMCAP)
     *                JDISK(IBND) = 4
  880     CONTINUE
C
C...      CHECK IF SORTING REQUIRED FOR AN RPM
          IF ((KREP .EQ. 4 .OR. KTWO .NE. 0) .AND. (JSORT .EQ. 1
     *              .OR. (JSORT .EQ. 2 .AND. MTAPE .NE. 1 .AND.
     *              JDISK(IBND) .NE. 3 .AND. JDISK(IBND) .NE. 4 .AND.
     *              BYTKNT(IBND) .GT. PMCAP)))
     *           KSORT(IBND) = KSORT(IBND) + 2
C
C...      CHECK IF PARTITIONING NECESSARY
          IF (KSORT(IBND) .NE. 0 .OR. (JSORT .NE. 0 .AND.
     *              KREP .NE. 4 .AND. IBXMAX .GT. 32767 .AND.
     *              MTAPE .EQ. 0))
     *           GO TO 890
C
C...        NO PARTITIONING -
C           CHECK IF COPY COMMAND CAN BE USED WITH THE RPM
            IF (BYTKNT(IBND) .GT. PMCAP .AND. JDISK(IBND) .NE. 2
     *              .AND. JDISK(IBND) .NE. 3 .AND. JDISK(IBND) .NE. 4)
     *             ICPCMD = 0
            GO TO 895
C
C...        PARTITIONING -
C           CHECK IF COPY COMMAND CAN BE USED WITH THE RPM
  890       IF (JDISK(IBND) .NE. 2)  ICPCMD = 0
C
C...      SET GLOBAL SORT FLAG
  895     IF (KSORT(IBND) .NE. 0) ISORT = -1
C
  900 CONTINUE
C
C...  ONLY SEND MULTIPLE COPIES TO TAPE IF
C     THE COPY COMMAND IS TO BE USED
      IF (MTAPE .EQ. 2 .AND. ICPCMD .EQ. 0) ICOPY = 1
C
C
C     *************************************************************
C     * THIS LOOP INSERTS THE REQUIRED MOVE/DRAW CMD FOR SPACING  *
C     * BETWEEN COPIES/PLOTS; END-VRF, REWIND, FORM-FEED AND SKIP *
C     * COMMANDS IF REQUIRED.                                     *
C     *************************************************************
C
C...    SEE IF EACH DATA BUFFER FOR EACH PARTITION NEEDS FLUSHING
      IDTBND = 0
      DO 1100 IBND = 1,NCPASS,1
         IF (VRFKNT(IBND) .EQ. 0) GO TO 1100
         IDTBND = IDTBND + 1
         ITNSEQ(IBND) = - ITNSEQ(IBND)
C
C...     CHECK IF INVISIBLE DOT SHOULD BE DRAWN TO GET SPACE
C
C...     CHECK IF COLOR OR COPY COMMAND TO BE USED
         IF (IVCFLG .NE. 0 .OR. ICPCMD .NE. 0)  GO TO 980
C
C...     SET FF/SPACE FLAG
         ISPFF = ISPACE
C
C...     IF SINGLE COPY, USE IFFAP FLAG
         IF (ICOPY .EQ. 1)  ISPFF = IFFAP
C
C...     CHECK IF FORM-FEED OR ZERO SPACE REQUESTED
         IF (ISPFF .LE. 0)  GO TO 980
C
C...     SET SPACE LIMIT FOR DEVICE
           IPLMAX = 32759
           IF (KREP .EQ. 4)  IPLMAX = 32767
           IF (PRECIS .EQ. 32)  IPLMAX = 2147483647
C
C...     COMPUTE SPACE AFTER PLOT AND MAXIMUM ALLOWABLE SPACE
           I = ISPFF * INT(RDEN/UNITS)
           J = IPLMAX - IBXMAX
C
C...     CHECK IF MOVE/DRAW REQUIRED
           IF (J .LE. 0)  GO TO 980
C
C...     CHECK IF 32 BIT PRECISION
           IF (PRECIS .EQ. 32)  GO TO 940
C
C...     CHECK IF IBXMAX TOO LARGE FOR 16 BIT PRECISION
           IF (I  .LE. J)  GO TO 940
           IBXMAX = IPLMAX
           CALL MSGLG1 (126)
           GO TO 960
C
C...     COMPUTE NEW IBXMAX
  940    IBXMAX = IBXMAX + I
C
C...     OUTPUT SET PEN #0 COMMAND
  960    CALL OCHUNK (ISETPN, 0)
         CALL OCHUNK (0, 0)
C
C...     OUTPUT MOVE/DRAW
         CALL OCHUNK (IBXMAX, -1)
         CALL OCHUNK (0, -1)
         CALL OCHUNK (IBXMAX, -1)
         CALL OCHUNK (MSB, -1)
C
C...     COUNT THE CONSTRUCT
         VRFKNT(IBND) = VRFKNT(IBND) + DRWELM
C
C...     OUTPUT END-OF-PLOT CODE
  980    CALL OCHUNK (IEVRF, 0)
C
C...     ISSUE A REWIND IF NOT LAST PARTITION
         IF (NDTBND .EQ. IDTBND) GO TO 1000
         CALL OCHUNK (ICC04, 0)
         CALL OCHUNK (IREW, 0)
         CALL OCHUNK (0, 0)
         GO TO 1020
C
C...     OUTPUT AN IMMEDIATE PAPER CUT IF NECESSARY
 1000    IF (ICUT .NE. -1)  GO TO 1010
           CALL OCHUNK (ICC04, 0)
           CALL OCHUNK (ICUTP, 0)
           CALL OCHUNK (0, 0)
C
C...     OUTPUT A FORM FEED IF NECESSARY
 1010    IF (IVCFLG.NE.0 .OR. (ICOPY .EQ. 1 .AND. IFFAP .EQ. -1) .OR.
     *         (ICOPY.GT.1 .AND. ((ICPCMD.EQ.0 .AND. ISPACE.EQ.-1) .OR.
     *         (ICPCMD.EQ.1 .AND. IFFAP .EQ.-1)))) CALL OCHUNK (IC200,0)
C
C...     CALCULATE REMAINING BYTE COUNT
 1020    IBYTS = (MAX(IBND) - NEXTO(IBND) + 1) * 2
C
C...     INSERT SKIP COMMANDS
 1040    IF (IBYTS .LE. 256)  GO TO 1060
         ISKIP = OR (ISKIP0,254)
         CALL OCHUNK (ISKIP,0)
         NEXTO(IBND) = NEXTO(IBND) + 127
         IBYTS = IBYTS - 256
         GO TO 1040
C
C...     INSERT LAST SKIP COMMAND
 1060    IF (IBYTS .EQ. 0) GO TO 1080
         ISKIP = OR (ISKIP0,IBYTS-2)
         CALL OCHUNK (ISKIP,0)
C
C...     FLUSH THE LAST BUFFER
 1080    OBUF(IBEGIN(IBND)) = 0
         CALL RWAIT
         CALL RWRIT(OBUF(IBEGIN(IBND)),IREC(IBND))
         ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
 1100 CONTINUE
C
C...  INCREMENT PLOT COUNT
      NPLOT = NPLOT + 1
      CALL RWAIT
C
C     ********************************************************
C     * THIS LOOP OUTPUTS THE PARTITION HEADER RECORDS AFTER *
C     * INSERTING THE REQUIRED PLOTTING PARAMETERS.          *
C     ********************************************************
C
C...    WRITE PARTITION HEADERS FOR PARTITIONS WITH ELEMENTS
      IDTBND = 0
      DO 1240 IBND=1,NCPASS,1
         IF (VRFKNT(IBND) .EQ. 0) GO TO 1240
C
C...  ZERO OUT HEADER RECORD
         DO 1120 I = 1,LREC
           OBUF(I) = 0
 1120    CONTINUE
         IDTBND = IDTBND + 1
C
C...     SET PHASE II PARTITIONING FLAG
         OBUF(2) = KSORT(IBND)
C
C...     PUT VRFKNT IN PARTITION HEADER
         OBUF(8) = INT(VRFKNT(IBND))
C
C...     PUT PARTITION XMAX IN PARTITION HEADER
         OBUF(9) = IBXMAX
C
C...     NO X-STRIPPING IF RPM OR IF PARTITION FLAG IS 0
         IF (KREP .EQ. 4 .OR. JSORT .EQ. 0)  GO TO 1150
C
C...     SET X-STRIPPING FLAG FOR PHASE II
         IF (IBXMAX .GT. 32759 .AND. MTAPE .EQ. 0)  OBUF(10) = -1
         IF (OBUF(10) .EQ. -1)  ISORT = -1
 1150    CONTINUE
C
C...     INSERT PLOT LENGTH FOR PHASE II IF COLOR FLAG SET
         IF (IVCFLG .NE. 0)
     *     OBUF(11) = MAX1((FLOAT(IBXMAX)+RDEN-1.0)/RDEN,1.0)
C
C...     INSERT SINGLE/MULTI-PASS COUNT
         OBUF(12) = NDTBND
C
C...     SET LINKS TO NEXT DATA RECORD AND PARTITION HEADER
         OBUF(1) = IDASRT(IBND)
         OBUF(5) = NREC
         ICAREC = NREC
         NREC = NREC + 1
         OBUF(3) = NREC
C
C...     IF END-OF-JOB CALL, SET ZERO LINK POINTER
         IF (KPEN .EQ. IEOJ .AND. NDTBND .EQ. IDTBND)  OBUF(3) = 0
C
C...     SET PLOT NUMBER/COPY COUNT
         OBUF(6) = NPLOT - 1
         OBUF(7) = ICOPY
C
C...     INSERT TONER NUMBER FOR THIS PLOT
         IF (VRFKNT(IBND) .NE. 0)  OBUF(13) = ITNSEQ(IBND)
C
C...     INSERT AUTHOR FIELD CHARACTER COUNT
         OBUF(14) = NCH
C
C...     INSERT AUTHOR FIELD
         IB = (NCH+3) / 4
         DO 1160 I = 1,IB
           OBUF(I+14) = IAUTXT(I)
 1160    CONTINUE
C
C...     SET NUMBER OF ELEMENT BYTES IN VRF PARTITION
         OBUF(30) = INT(BYTKNT(IBND))
C
C...     SET COPY COMMAND FLAG WORD
         OBUF(31) = ICPCMD
C
C...     SET PAPER CUT FLAG
         OBUF(32) = ICUT
C
C...     SET LENGTH OF PLOT
         OBUF(33) = IBXMAX
C
C...     OUTPUT RECORD
         CALL RWRIT (OBUF(1),NHEAD)
         CALL RWAIT
C
C...     OUTPUT CONTROL ARRAY
         DO 1180 I = 1,LREC
           OBUF(I) = 0
 1180    CONTINUE
C
C...     SET NUMBER OF CONTROL ARRAY ENTRIES
         OBUF(1) = IPRISM(1)
C
C...     SET PRISM CONTROL ARRAY FLAGWORD
         OBUF(2) = IPRISM(2)
C
C...     SET NUMBER OF ELEMENT BYTES IN VRF PARTITION
         OBUF(3) = INT(BYTKNT(IBND))
C
C...     SET PARTITION SIZE
         OBUF(4) = IBXMAX + 1
C
C...     SET MAXIMUM X
         OBUF(5) = IBXMAX
C
C...     SET REST OF ARRAY
         ITMP = IPRISM(1) + 1
         DO 1200 I = 6, ITMP
         OBUF(I) = IPRISM(I)
 1200    CONTINUE
C
C...     SET RPM DISK CONTROL FLAG
         OBUF(15) = JDISK(IBND)
         CALL RWRIT (OBUF(1),ICAREC)
         CALL RWAIT
C
C...     RESET THE HEADER POINTER FOR NEXT TIME IF NOT LAST
         IF (KPEN .EQ. IEOJ .AND. NDTBND .EQ. IDTBND) GO TO 1240
         NHEAD = NREC
         NREC = NREC + 1
 1240 CONTINUE
C
C...    RESET ITNSEQ TO ORIGINAL VALUE
 1260 DO 1280 IBND=1,NCPASS,1
         ITNSEQ(IBND) = NTNSEQ(IBND)
 1280 CONTINUE
C
C...  CHECK FOR END-OF-JOB CALL
      IF (KPEN .EQ. IEOJ)  GO TO 1300
C
C...  INITIALIZE FOR NEXT PLOT
      CALL VPINIT
      GO TO 1380
C
C     ****************************************************
C     * END-OF-JOB PLOT CALL, UPDATE AND OUTPUT THE FILE *
C     * HEADER RECORD.                                   *
C     ****************************************************
C
C...  OUTPUT PARAMETER BLOCK
 1300 CALL RWAIT
      DO 1320 I = 1,LREC
         OBUF(I) = 0
 1320 CONTINUE
C
C...  IF NO DATA GENERATED, SET NREC
      IF (NDTBND .EQ. 0)  NREC = NHEAD + 1
C
C...  PASS NUMBER OF RECORDS IN FILE
      OBUF(1) = NREC - 1
C
C...  PASS FILE SORT FLAG
      OBUF(2) = ISORT
C
C...  PASS MAX PARTITION ELEMENT SIZE
      OBUF(3) = INT(RMXELM)
C
C...  SET COLOR RANDOM VERSION NUMBER
      OBUF(4) = 102
C
C...  SET POINTER TO FIRST PLOT HEADER
      OBUF(5) = 2
C
C...  SET MUX, PDQ AND SPACE SUPPORT
      OBUF(6) = KREP
      OBUF(7) = INITFF
      OBUF(8) = IFFAP
      OBUF(9) = ISPACE
      OBUF(10) = LASTFF
      OBUF(11) = INT(RDEN)
      OBUF(12) = IBYTES
      OBUF(13) = MUXOUT
      OBUF(14) = INHNCE
      OBUF(15) = INVERS
      OBUF(16) = MIRROR
      OBUF(17) = IRDT
      OBUF(18) = -2
      IF (ISFLAG .NE. 0)  OBUF(18) = ISPEED
      OBUF(19) = IDISK
      OBUF(20) = INT(RDEN/UNITS)
      OBUF(21) = KTWO
      OBUF(22) = INT(PSIZE)
      OBUF(23) = PRECIS
      OBUF(24) = MTAPE
C
C...  OUTPUT RECORD
      NREC = 1
      CALL RWRIT (OBUF(1),NREC)
      CALL RWAIT
C
C...  OUTPUT NULL HEADER IF NECESSARY
      IF (NDTBND .NE. 0)  GO TO 1360
      DO 1340 I = 1,LREC
        OBUF(I) = 0
 1340 CONTINUE
      CALL RWRIT (OBUF(1),NHEAD)
      CALL RWAIT
 1360 CONTINUE
C
C...  CLOSE OUTPUT FILE
      CALL RCLOS
C
C
C...  CHECK IF PHASE II NEEDS TO BE CALLED
      IOPEN = -2
      IF (MODE1 .EQ. 0) GO TO 1370
C-C
C...     ACTIVATE THE FOLLOWING TWO LINES OF CODE
C...     TO SUPPORT THE VRF OUTPUT OPTION
C        CALL VRFPLT
C        IOPEN = 0
C-C
C
C...  SET UP SO PLOTS CAN BE CALLED AGAIN
 1370 ICOMD(1) = 36099
      ICOMD(2) = 35586
      IHBUF(1) = 33536
      IHBUF(2) = 33025
      ICXPTS = 127
      MAXPAT = 255
      MAXPEN = 31
      ISORT = 0
      IF (KTWO .EQ. 1) KREP = 0
      IF (IPEN .NE. IEOJ) CALL PLOTS(0,0,0)
C
 1380 IF (NPLOT .GT. 999)  NPLOT = 1
      RETURN
      END
