	SUBROUTINE VRFPLT
C
C	NAME:  VRFPLT
C
C	VRFPLT - SUBROUTINE TO PARTITION THE VRF FILE AND OUTPUT
C	         THE DATA TO THE CONFIGURED OUTPUT DEVICE.
C
C
C	LANGUAGE:  FORTRAN
C
C	OPERATING SYSTEM:  DEC VAX/VMS
C
C	ORDER NUMBER:  5448-SE
C
C	PART NUMBER:  000-025522-001  OCTOBER 1985
C
C	PRODUCT:  DEC VAX/VMS 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	 1/18/84	RE-INITIALIZE VARIABLE IFIRST FOR
C				MULTIPLE COPIES.
C	REV. C	 1/25/85	CHANGE PROGRAM RANDOM TO SUBROUTINE
C				VRFPLT CALLABLE FROM PHASE I AND
C				PROGRAM RANDOM.
C
C				ADD CODE TO SUPPORT PRISM CONTROLLER,
C				PDQ PLOTTERS AND 511 MUX.
C
C				CHANGE CODE TO CONSTRUCT AND OUTPUT
C				THE FIRST VDS BLOCK WITH THE USER
C				SELECTED OPTIONS SUCH AS PDQ, PRISM,
C				AND MUX.
C
C	CALLS:  BAND,ROPEN,RREAD,RCLOS,ATTACH,OEOF,RWAIT,OUTPUT,DETACH,
C		STRVRF,MSGLG2
C
C	COMMON USED:
C	/BSORT/
C		I IBUF    - VRF INPUT BUFFER
C		I ISIZE   - DIMENSION OF IVBUF ARRAY
C		I IWRD    - INDEX INTO IVBUF
C		I MSKALL  - MASK WITH ALL BITS TURNED ON
C		I NBYTS   - BYTE COUNT OF OUTPUT RECORD
C		I NCHUNK  - NUMBER OF 16-BIT CHUNKS PER OUTPUT WORD
C		I IVBUF   - ARRAY USED FOR SORT AND OUTPUT BUFFERS.
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		I IOTYPE  - INDICATES TYPE OF OUTPUT (PRINT OR PLOT)
C
C	/MSGCOM/
C		I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS
C
C	LOCAL VARIABLES:
C
C		I I	  - TEMPORARY VARIABLE
C		I IA      - LOOP COUNTER
C		I IBXMAX  - PLOT MAXIMUM X VALUE
C		I IBYTS   - REMAINING BYTES TO SKIP
C		I ICLCMD()- PLOTTER COLOR COMMAND WORDS
C		I ICOPY   - CURRENT COPY COUNT
C		I ICPCMD  - COPY COMMAND FLAG
C		I ICPLEN  - PLOT LENGTH FOR COLOR COMMAND
C		I ICUT    - PAPER CUT FLAG
C		I IDENS   - PLOTTER NIBS/INCH
C		I IDISK   - CONTROLLER DISK FLAG
C		I IESCP   - COLOR COMMAND WORD
C		I IFFCMD  - FF/SKIP COMMAND
C		L IFIRST  - FIRST PASS INDICATOR
C		I IFRAME()- VDS FRAME HEADER WORDS
C		I INBUF2  - DOUBLE BUFFER POINTER
C		I INHNCE  - LINE ENHANCE FLAG
C		I INITFF  - INITIAL FF FLAG
C		I INVERS  - INVERSE IMAGE FLAG
C		I IPASS   - MULIT-PASS BIT FOR COLOR COMMAND
C		I IPDQ    - PLOTTER COMMAND USED FLAG
C		I IPLEN   - COLOR PLOT LENGTH IN INCHES
C		I IPLOT   - CURRENT PLOT NUMBER
C		I IPSALL  - PRINT PASS-ALL COMMAND
C		I IRDT    - RASTER DATA TRANSLATE FLAG
C		I ISKIP0  - VDS SKIP COMMAND
C		I ISPACE  - SPACE/FF BETWEEN COPIES
C		I ISPD    - PLOTTER SPEED COMMAND WORDS
C		I ISPEED  - PLOTTER SPEED VALUE
C		I ISTART  - CURRENT PLOT HEADER RECORD POINTER
C		I ITEMPL  - I*4 VARIABLE EQUIVALENCED TO ITEMPW
C		I ITEMPW()- I*2 VARIABLE EQUIVALENCED TO ITEMPL
C		I ITONER  - CURRENT TONER NUMBER
C		I JCMD    - SKIP COMMAND + COUNT
C		I KCOPY   - WORKING COPY COUNT
C		I KHEAD   - NEXT PLOT HEADER RECORD POINTER
C		I KNT     - AUTHOR TEXT WORD COUNT
C		I KPASS   - NUMBER OF REMAINING COLOR PASSES
C		I KPLOT   - NEXT PLOT NUMBER
C		I KPTR    - POINTER TO CURRENT OUTPUT BUFFER
C		I KREP    - TARGET OUTPUT DEVICE
C		I KRTN    - GO TO JUMP INDEX
C		I KTWO    - REP/PRISM CONTROLLER FLAG
C		I LASTFF  - LAST FORM-FEED FLAG
C		I MIRROR  - MIRROR IMAGE FLAG
C		I MGTAPE  - TAPE OUTPUT FLAG
C		I MUXOUT  - OUTPUT MULTIPLEXER FLAG
C		I NCOPY   - PLOT COPY COUNT
C		I NDOTS   - RDEN/UNITS VALUE
C		I NHEAD   - NEXT FRAME POINTER
C		I NPASS   - NUMBER OF COLOR PASSES
C		I NREC    - NEXT RECORD POINTER
C
C
	INCLUDE 'BSORT.CMN'
C
C
	INCLUDE 'IOCOM.CMN'
C
C
	INCLUDE 'MSGCOM.CMN'
C
	LOGICAL IFIRST, LSTCPY
	DIMENSION ICLCMD(5), IFRAME(6), ISPD(4)
	INTEGER*2 ISAVE(4)
	INTEGER*2 ITEMPW(2)
	INTEGER*4 ITEMPL
	EQUIVALENCE (ITEMPL, ITEMPW(1))
C
C...	MAXIMUM BYTE COUNT FOR AN 1802 COMMAND
	DATA MXBYTS/ 8192 /
C
C...	FRAME HEADER WORDS: '1801,0,1802,0,1802,0'X
	DATA IFRAME/ 6145, 0, 6146, 0, 6146, 0 /
C
C...	COLOR COMMAND 'CC08,9B50,0004,0000,0000'X
	DATA ICLCMD/ 52232, 39760, 4, 0, 0 /
C
C...	SPEED COMMAND: 'CC06,9B53,2,0'X
	DATA ISPD/ 52230, 39763, 2, 0 /
C
C...	PRINT PASS ALL COMMAND: 'CC04'X
	DATA IPSALL/ 52228 /
C
C...	FORM-FEED/SKIP COMMAND: 'C200'X, 'C000'X
	DATA IFFCMD/ -15872 /, ISKIP0/ -16384 /
C
C
C
C
C-W  *****  SYSTEM DEPENDENT VARIABLES  *****
C...	INITIALIZE COMMON VARIABLES
C
C...	MSKALL - MASK WITH ALL BITS TURNED ON
	MSKALL = -1
C
	ISIZE = 153600
	NCHUNK = 1
C
C-W  *****
C
C...	INITIALIZE PLOT NUMBER AND COPY COUNTS
	IPLOT = 1
	ICOPY = 1
C
C...	OPEN FILE AND READ IN FILE HEADER RECORD
	CALL ROPEN (2)
	CALL RREAD (IBUF(1), 1)
	CALL RWAIT
C
C...	CHECK IF CORRECT VERSION OF FILE
	ITEMPW(1) = IBUF(5)
	ITEMPW(2) = IBUF(6)
	IF (ITEMPL .NE. 102)  GO TO 9000
C
C...	INITIALIZE PLOTTING VARIABLES
	ITEMPW(1) = IBUF(9)
	ITEMPW(2) = IBUF(10)
	NHEAD  = ITEMPL
	KREP   = IBUF(13)
	INITFF = IBUF(14)
	IFFAP  = IBUF(15)
	ISPACE = IBUF(16)
	LASTFF = IBUF(17)
	IDENS  = IBUF(18)
	MUXOUT = IBUF(20)
	INHNCE = IBUF(21)
	INVERS = IBUF(22)
	MIRROR = IBUF(23)
	IRDT   = IBUF(24)
	ISPEED = IBUF(25)	
	IDISK  = IBUF(26)
	NDOTS  = IBUF(27)
	KTWO   = IBUF(28)
	MGTAPE = IBUF(32)
	ISTART = NHEAD
	IPDQ = -1
C
C	*********************************
C...	*  PARTITION THE PLOT IF REQ'D  *
C	*********************************
C
C...	CALL BAND SUBROUTINE TO PARTITION THE PLOT IF REQUIRED
	IF (IBUF(2) .NE. 0)  CALL BAND
C
C...	INITIALIZE OUTPUT BLOCK SIZE
	NBYTS = (LREC-2)*NCHUNK*2
C
	KBYTS = NBYTS - 4
	KWRDS = KBYTS / (2*NCHUNK)
C
C...	CHECK IF MAG TAPE OUTPUT
	IF (MGTAPE .EQ. 0)  GO TO 80
C
C...	  ONLY OUTPUT 1 RECORD AT A TIME
	  MXBYTS = KBYTS
	  GO TO 90
C
C...	  ADJUST THE BYTE COUNT BASED ON THE SIZE OF
C	  THE IVBUF ARRAY AND THE INPUT RECORD SIZE.
C	  WE MUST HAVE ROOM FOR TWO OUTPUT BUFFERS.
C
   80	  IF (MXBYTS .GT. 32762) MXBYTS = 32762
	  IF ((MXBYTS+8) .GT. (ISIZE*NCHUNK))
     *	      MXBYTS = ISIZE*NCHUNK-8
	  MXBYTS = (MXBYTS/KBYTS)*KBYTS
	  IF (MXBYTS .LT. KBYTS) MXBYTS = KBYTS
C
C...	INIT BUFFER POINTERS
   90	KPTR = 1
	INBUF2 = KPTR + (MXBYTS+8)/(2*NCHUNK)
C
C...	ATTACH OUTPUT DEVICE
	CALL ATTACH
C
C...	INDICATE OUTPUT STARTED
	CALL MSGLG2(13)
C
C...	CHECK IF NO MORE PARTITIONS
  100   IF (NHEAD .EQ. 0)  GO TO 9999
C
C...	READ PARTITION HEADER
	CALL RREAD (IBUF(1), NHEAD)
	CALL RWAIT
C
C...	SAVE PARTITION HEADER INFO
C...	SAVE POINTER TO FIRST DATA RECORD
C...	POINTER TO NEXT PARTITION HEADER
C...	AND NUMBER OF COPIES
	ISTART = NHEAD
	ITEMPW(1) = IBUF(1)
	ITEMPW(2) = IBUF(2)
	NREC = ITEMPL
	ITEMPW(1) = IBUF(5)
	ITEMPW(2) = IBUF(6)
	NHEAD = ITEMPL
	KPLOT = IBUF(11)
	IFIRST = .TRUE.
C
C...	SET FIRST PASS FLAG BIT
	IPASS = 4
C
C...	CHECK IF DUMMY PARTITION
  120	IF (NREC .EQ. 0)  GO TO 100
C
C...	NEW PLOT OR NEXT COLOR, UPDATE VARIABLES
	NCOPY  = IBUF(12)
	KCOPY  = NCOPY
	IPLEN  = IBUF(18)
	NPASS  = IBUF(19)
	ITONER = IBUF(20)
	ICPCMD = IBUF(55)
	ICUT = IBUF(56)
	ITEMPW(1) = IBUF(57)
	ITEMPW(2) = IBUF(58)
	IBXMAX = ITEMPL
C
C...	INITIALIZE OR DECREMENT NUMBER OF REMAINING COLOR PASSES
	IF (IFIRST) KPASS = NPASS
	KPASS = KPASS - 1
C
C...	SAVE CURRENT PLOT NUMBER
	IPLOT  = KPLOT
C
C...	INITIALIZE FF/SPACE AFTER COPIES
	JSPACE = ISPACE
	IF (ICPCMD .NE. 0 .AND. JSPACE .LT. 0 .AND. ( IPLEN .NE. 0 .OR.
     *	    ISPEED .NE. 0 .OR. IRDT .NE. 0 .OR. MIRROR .NE. 0 .OR.
     *	    INVERS .NE. 0 .OR. INHNCE .NE. 0 ) )  JSPACE = 2
C
C...	INITIALIZE FLAG INDICATING WHETHER A FORM FEED AFTER PLOT
C	NEEDS TO BE OUTPUT (AND WAS NOT DONE IN PHASE 1)
	JFFAP = 0
	IF (IFFAP .LT. 0 .AND. IPLEN .EQ. 0 .AND. ICPCMD .EQ. 0 .AND.
     *	    NCOPY .GT. 1)  JFFAP = -1
C
C...	FIRST PARTITION, INITIALIZE POINTERS
	IWRD   = KPTR
C
C...	OUTPUT FRAME HEADERS
	DO 170 IA = 1,6
	  CALL STRVRF ( IFRAME(IA) )
  170	CONTINUE
C
C	************************
C...	*  OUTPUT MUX COMMAND  *
C	************************
C
C...	CHECK IF OUTPUT MUX SPECIFIED AND FIRST PASS
	IF (MUXOUT .EQ. 0)  GO TO 200
C
C...	YES, OUTPUT MUX COMMAND '1B30'X
	  ITEMPL = 6960 + MUXOUT
C
C...	PASS ALL PRINT - 'CC02'X
	  CALL STRVRF ( 52226 )
	  CALL STRVRF ( ITEMPL )
C
C...	ONLY OUTPUT MUX COMMAND ONCE
	  MUXOUT = 0
C
C	*************************
C...	*  OUTPUT INITIAL FF    *
C	*************************
C
C...	CHECK IF INITIAL FF REQ'D 'C200'X
  200	IF (INITFF .NE. 0)  CALL STRVRF ( IFFCMD )
C
C...	ONLY OUTPUT INITIAL FF ONCE
	INITFF = 0
C
C	*************************
C...	*  OUTPUT AUTHOR FIELD  *
C	*************************
C...	GET AUTHOR TEXT COUNT
	KNT = IBUF(21)/2
C
C...	SKIP COMMAND 'C0NN'X
	JCMD = ISKIP0 + KNT*2 + 2
C
C...	OUTPUT AUTHOR COMMAND
	CALL STRVRF ( JCMD )
C
C...	'4944'X
	CALL STRVRF ( 18756 )
C
C...	OUTPUT TEXT
	DO 210 IA = 1,KNT
	  ITEMPL = IBUF(21+IA)
	  CALL STRVRF ( ITEMPL )
  210	CONTINUE
C
C	**************************
C...	*  OUTPUT CONTROL ARRAY  *
C	**************************
C
C...	OUTPUT CONTROL ARRAY IF RPM CONTROLLER
	IF (KREP .EQ. 1 .AND. KTWO .EQ. 0)  GO TO 240
C
C...	READ IN CONTROL ARRAY RECORD
	ITEMPW(1) = IBUF(9)
	ITEMPW(2) = IBUF(10)
	CALL RREAD (IBUF(1), ITEMPL)
	CALL RWAIT
C
C...	GET CONTROL ARRAY COUNT
	ITEMPW(1) = IBUF(1)
	ITEMPW(2) = IBUF(2)
	KNT = ITEMPL
C
C...	OUTPUT CONTROL ARRAY LEVEL 1 COMMAND 'C6NN'X
	ITEMPL = 50688 + (KNT-4)*2 + 16
	CALL STRVRF ( ITEMPL )
C
C...	FIRST CONTROL ARRAY ENTRY IS 'PCA1' - '50434131'X
	CALL STRVRF ( 20547 )
	CALL STRVRF ( 16689 )
C
C...	MOVE CONTROL ARRAY TO OUTPUT BUFFER
C
C...	NEXT THREE ENTRIES ARE 32 BITS
	ITEMPL = IBUF(6)
	CALL STRVRF ( ITEMPL )
	ITEMPL = IBUF(5)
	CALL STRVRF ( ITEMPL )
	ITEMPL = IBUF(8)
	CALL STRVRF ( ITEMPL )
	ITEMPL = IBUF(7)
	CALL STRVRF ( ITEMPL )
	ITEMPL = IBUF(10)
	CALL STRVRF ( ITEMPL )
	ITEMPL = IBUF(9)
	CALL STRVRF ( ITEMPL )
C
C...	REMAINING ENTRIES ARE 16 BITS
	KNT = KNT + 6
	DO 230 IA = 11,KNT
	  ITEMPL = IBUF(IA)
	  CALL STRVRF ( ITEMPL )
  230	CONTINUE
C
C	*****************************
C...	*  OUTPUT PAPER CUT COMMAND *
C	*****************************
C
C...	CHECK IF PAPER CUT REQUIRED
  240	IF (ICUT .NE. 1 .OR. (.NOT. IFIRST))  GO TO 300
C
	  CALL STRVRF ( IPSALL )
C
C...	  COMMAND: '9B47' '0000'
	  CALL STRVRF ( 39751 )
	  CALL STRVRF ( 0 )
C
C	*****************************
C...	*  OUTPUT COLOR COMMAND     *
C	*****************************
C
C...	CHECK IF COLOR PLOT
  300	IF (IPLEN .EQ. 0)  GO TO 400
C
C...	CHECK IF FIRST PASS
	  ICLCMD(4) = 0
	  IF (.NOT. IFIRST)  GO TO 340
C
C...	FIRST PASS OF COLOR PLOT, COMPUTE PLOT LENGTH
	    ICLCMD(4) = IPLEN
C
C...	CHECK IF SINGLE COPY (OR NO COPY COMMAND)
	    IF (ICPCMD .EQ. 0)  GO TO 320
C
C...	MUST ACCOUNT FOR SPACE BETWEEN COPIES
  305	      ICLCMD(4) = (IPLEN * KCOPY) +
     *	        ((JSPACE*NDOTS) * (KCOPY-1)+IDENS-1)/IDENS
C
C..	CHECK PLOT LENGTH
  320	    IF (ICLCMD(4) .LE. 4095)  GO TO 328
C
C...	PLOT TOO LONG, CHECK COPY COUNT
	      IF (ICPCMD .EQ. 0 .OR. KCOPY .EQ. 1)  GO TO 325
C
C...	TRY DECREASING COPY COUNT
	        KCOPY = KCOPY - 1
	        INTARG(1) = KCOPY
	        GO TO 305
C
C...	PLOT TOO LONG, TELL USER
  325	      CALL MSGLG2 (15)
	      GO TO 9998
C
C...	TELL USER COPY COUNT WAS DECREMENTED
  328	    IF (KCOPY .NE. NCOPY)  CALL MSGLG2(17)
C
C...	CHECK FOR SINGLE PASS COLOR
  340	  IF (NPASS .EQ. 1)  IPASS = 0
C
C...	CHECK IF LAST PASS
	  IF (KPASS .EQ. 0)  IPASS = IPASS + 16
C
C...	SET FIRST/INTERMEDIATE PASS FLAG
	  ICLCMD(5) = (ITONER - 1 + IPASS) * 256
C
C...	MOVE COLOR PREAMBLE TO OUTPUT BUFFER
	DO 370 IA = 1,5
	  CALL STRVRF ( ICLCMD(IA) )
  370	CONTINUE
C
C...	SET FLAGS TO INDICATE INTERMEDIATE PASS
	IPASS = 8
C
C	*****************************
C...	*  OUTPUT PLOTTER COMMANDS  *
C	*****************************
  400	CONTINUE
C
C...	CHECK IF FIRST TIME
	IF ( IPDQ .EQ. 0 )  GO TO 500
C
C...	CHECK IF LINE ENHANCE SELECTED
  	IF (INHNCE .EQ. 0)  GO TO 420
	  CALL STRVRF ( IPSALL )
C
C...	COMMAND: '9B45,0'X
	  CALL STRVRF ( 39749 )
	  CALL STRVRF ( 0 )
C
C...	CHECK IF INVERSE SELECTED
  420	IF (INVERS .EQ. 0)  GO TO 440
	  CALL STRVRF ( IPSALL )
C
C...	COMMAND: '9B49,0'X
	  CALL STRVRF ( 39753 )
	  CALL STRVRF ( 0 )
C
C...	CHECK IF MIRROR IMAGE SELECTED
  440	IF (MIRROR .EQ. 0)  GO TO 460
	  CALL STRVRF ( IPSALL )
C
C...	COMMAND: '9B4D,0'X
	  CALL STRVRF ( 39757 )
	  CALL STRVRF ( 0 )
C
C...	CHECK IF DATA TRANSLATE
  460	IF (IRDT .EQ. 0)  GO TO 480
	  CALL STRVRF ( IPSALL )
C
C...	COMMAND: '9B52,0'X
	  CALL STRVRF ( 39762 )
	  CALL STRVRF ( 0 )
C
C...	CHECK IF SPEED CONTROL SPECIFIED
  480	IF (ISPEED .EQ. -2)  GO TO 500
	  ISPD(4) = IAND(ISPEED,255)
	  DO 490 IA = 1,4
	    CALL STRVRF ( ISPD(IA) )
  490	  CONTINUE
C
  500	IPDQ = 0
C
C	**************************
C...	*  OUTPUT COPY COMMAND   *
C	**************************
C
C...	CHECK IF COPY COMMAND TO BE USED
	IF (ICPCMD .EQ. 0)  GO TO 560
C
C...	CALCULATE TOTAL COPY LENGTH
	  ICPLEN = IBXMAX
	  IF (JSPACE .LE. 0)  GO TO 540
	    ICPLEN = ICPLEN + (JSPACE * NDOTS)
C
C...	OUTPUT COMMAND WORD 'C506'X
  540	  CALL STRVRF ( 50438 )
C
C...	CHECK IF COPY COUNT TOO LARGE
	  ITEMPL = KCOPY
	  IF (ITEMPL .GT. 255) ITEMPL = 255
C
C...	OUTPUT COPY COUNT, NEGATIVE IF FF BETWEEN COPIES
	  IF (JSPACE .LT. 0)  ITEMPL = -ITEMPL
	  CALL STRVRF ( ITEMPL )
C
C...	OUTPUT TOTAL COPY LENGTH
	  I = IRAM (ICPLEN,16,MSKALL)
	  CALL STRVRF ( I )
	  CALL STRVRF ( ICPLEN )
C
C...	SET COPY COUNT EQUAL
	  ICOPY = KCOPY
C
C	***************************
C...	* OUTPUT THE FRAME HEADER *
C	***************************
C
C...	DETERMINE OUTPUT BYTE COUNT SO FAR
  560	  NBKNT = (IWRD - KPTR) * 2
C
C...	CHECK IF TAPE OUTPUT
	  IF (MGTAPE .EQ. 0)  GO TO 640
C
C...	FOR MAG TAPE(430) OUTPUT, THE OUTPUT BLOCKS MUST ALL BE THE
C	SAME LENGTH.  THE MAIN LOOP TO OUTPUT VRF (LABEL 700) WILL
C	ALWAYS OUTPUT (MXBYTS+4) SO WE PAD OUT THE FRAME HEADER TO
C	THIS VALUE.
C
C...	WE ASSUME THAT THE NUMBER OF BYTES OF DATA IN THE FRAME
C	HEADER (=NBKNT) IS LESS THAN (MXBYTS+4).  CURRENTLY, NBKNT
C	CAN BE AS GREAT AS 268 BYTES.
C
C...	PAD OUT TO MXBYTS+4
	  IBYTS = MXBYTS + 4 - NBKNT
	  NBKNT = MXBYTS + 4
C
C...	PUT IN THE SKIP COMMANDS
  610	  IF (IBYTS .LE. 256)  GO TO 620
	    ISKIP = IOR (ISKIP0,254)
	    CALL STRVRF (ISKIP)
	    IWRD = IWRD + 127
	    IBYTS = IBYTS - 256
	    GO TO 610
  620	  IF (IBYTS .EQ. 0)  GO TO 640
	    IBYTS = IBYTS-2
	    ISKIP = IOR (ISKIP0,IBYTS)
	    CALL STRVRF (ISKIP)
C
C...	UPDATE BYTE COUNT
  640	  IVBUF(KPTR+5) = NBKNT - 12
C
C...	OUTPUT THE BLOCK
	  CALL OUTPUT (IVBUF(KPTR), NBKNT)
C
C
C...	SWITCH BUFFER POINTERS
	  I = KPTR
	  KPTR = INBUF2
	  INBUF2 = I
C
C...	RESET FIRST PASS FLAG
	  IFIRST = .FALSE.
C...	*****************************
C	*  MAIN LOOP TO OUTPUT VRF  *
C	*****************************
C
C...	INITIALIZE FOR AN EMPTY OUTPUT BUFFER
	JPTR = KPTR
	NTBYTS = 0
	ISAVE(3) = 6146
	ISAVE(4) = MXBYTS
C
C...	READ IN RECORD
  700   CALL RREAD (IVBUF(JPTR), NREC)
C
C...	WAIT I/O DONE
	CALL RWAIT
C
C...	UPDATE NEXT RECORD POINTER
	ITEMPW(1) = IVBUF(JPTR)
	ITEMPW(2) = IVBUF(JPTR+1)
	NREC = ITEMPL
C
C...	RESTORE OVERWRITTEN BYTES
	IVBUF(JPTR)   = ISAVE(1)
	IVBUF(JPTR+1) = ISAVE(2)
	IVBUF(JPTR+2) = ISAVE(3)
	IVBUF(JPTR+3) = ISAVE(4)
C
C...	INCREMENT BYTE COUNT AND WORD POINTER
	NTBYTS = NTBYTS + KBYTS
	JPTR = JPTR + KWRDS
C
C...	CHECK FOR A FULL OUTPUT BUFFER
	IF (NTBYTS .NE. MXBYTS) GO TO 720
C
C...	  ADJUST BYTE COUNT TO INCLUDE THE 1802 BYTCNT
	  NTBYTS = NTBYTS + 4
	  JPTR = KPTR + 2
C
C...	  OUTPUT THE DATA
	  CALL OUTPUT (IVBUF(JPTR),NTBYTS)
C
C...	  SWITCH BUFFER POINTERS
	  I = KPTR
	  KPTR = INBUF2
	  INBUF2 = I
	  NTBYTS = 0
	  JPTR = KPTR
	  IVBUF(JPTR+2) = 6146
	  IVBUF(JPTR+3) = MXBYTS
C
C...	SAVE BYTES THAT ARE TO BE OVERWRITTEN
  720	ISAVE(1) = IVBUF(JPTR)
	ISAVE(2) = IVBUF(JPTR+1)
	ISAVE(3) = IVBUF(JPTR+2)
	ISAVE(4) = IVBUF(JPTR+3)
C
C...	CHECK IF LAST DATA RECORD IN CURRENT PARTITION
  740	IF (NREC .NE. 0)  GO TO 700
C
C...	SET NEXT PLOT NUMBER TO ZERO
	KPLOT = 0
C
C...	SET LAST COPY FLAG TO TRUE
	LSTCPY = .TRUE.
C
C...	CHECK IF ANY MORE PARTITION HEADER RECORD
	IF (NHEAD .EQ. 0)  GO TO 760
C
C...	GET NEXT PARTITION HEADER
	CALL RREAD (IBUF(1), NHEAD)
	KHEAD = NHEAD
	CALL RWAIT
	ITEMPW(1) = IBUF(1)
	ITEMPW(2) = IBUF(2)
	NREC = ITEMPL
	ITEMPW(1) = IBUF(5)
	ITEMPW(2) = IBUF(6)
	NHEAD = ITEMPL
	KPLOT = IBUF(11)
C
C...	CHECK IF COLOR PLOT
	IF (IPLEN .EQ. 0)  GO TO 750
C
C...	COLOR, CHECK IF SAME TONER
	KRTN = 2
	IF (IPLOT .EQ. KPLOT .AND. ITONER .NE. IBUF(20))  GO TO 840
C
C...	CHECK IF SAME PLOT
  750	IF (IPLOT .EQ. KPLOT)  GO TO 740
C
C...	DONE WITH THIS PLOT, SET FIRST PASS FLAGS
	IFIRST = .TRUE.
	IPASS = 4
C
C...	NEXT PLOT HEADER READ, CHECK IF COPIES DONE
  760	IF (ICOPY .NE. KCOPY)  GO TO 820
C
C...	  PROCESS NEXT PLOT
	  ICOPY  = 1
	  ISTART = KHEAD
	  KRTN   = 2
	  GO TO 840
C
C...	  COPIES NOT DONE
  820	  NHEAD = ISTART
	  ICOPY = ICOPY + 1
	  KRTN = 1
	  LSTCPY = .FALSE.
C
C...	CHECK FOR A PARTIALLY FILLED OUTPUT BUFFER
  840	IF (NTBYTS .EQ. 0) GO TO 850
C
C...	  PUT IN THE CORRECT BYTE COUNT
	  IVBUF(KPTR+3) = NTBYTS
C
C...	  ADJUST THE BYTE COUNT TO INCLUDE THE 1802 BYTCNT
	  NTBYTS = NTBYTS + 4
C
	  JPTR = KPTR + 2
C
C...	  OUTPUT THE BUFFER
	  CALL OUTPUT (IVBUF(JPTR),NTBYTS)
C
C...	  SWITCH BUFFER POINTERS
	  I = KPTR
	  KPTR = INBUF2
	  INBUF2 = I
C
C...	INITIALIZE DATA POINTER FOR LAST BLOCK
  850	IWRD = KPTR
C
C...	OUTPUT '1802'X '0000'X - THE COUNT WILL BE PUT IN LATER
	CALL STRVRF ( 6146 )
	CALL STRVRF ( 0 )
C
C...	OUTPUT FORM FEED AFTER PLOT AND LAST FF IF NECESSARY
	IF (JFFAP .NE. 0 .AND. LSTCPY)  CALL STRVRF ( IFFCMD )
	IF (KPLOT .EQ. 0 .AND. LASTFF .NE. 0 .AND. LSTCPY)
     *	    CALL STRVRF ( IFFCMD )
C
C...	DETERMINE BYTE COUNT SO FAR
	NBKNT = (IWRD - KPTR) * 2
C
C...	CHECK IF NO DATA IS TO BE OUTPUT
	IF (NBKNT .EQ. 4 .AND. KTWO .EQ. 0 .AND. KREP .EQ. 1)  GO TO 900
C
C...	CHECK FOR MAG TAPE OUTPUT
	IF (MGTAPE .EQ. 0)  GO TO 880
C
C...	FOR MAG TAPE(430) OUTPUT, THE OUTPUT BLOCKS MUST ALL BE THE
C	SAME LENGTH.  THE MAIN LOOP TO OUTPUT VRF (LABEL 700) WILL
C	ALWAYS OUTPUT (MXBYTS+4) SO WE PAD OUT THIS BLOCK TO
C	THIS VALUE.
C
C...	NOTE: THIS PADDING MUST BE DONE BEFORE THE END-OF-FRAME ('1803')
C	      BECAUSE THE 1803 CANNOT BE FOLLOWED BY ANYTHING EXCEPT
C	      ANOTHER PLOT OR JOB (STARTING WITH AN 1801)
C
C...	PAD OUT TO MXBYTS+4, BUT LEAVE ROOM FOR 1803 IF NECESSARY
	  IBYTS = MXBYTS + 4 - NBKNT
	  IF (KREP .EQ. 4 .OR. KTWO .NE. 0)  IBYTS = IBYTS - 4
	  NBKNT = NBKNT + IBYTS
C
C...	PUT IN THE SKIP COMMANDS
  860	  IF (IBYTS .LE. 256)  GO TO 870
	    ISKIP = IOR (ISKIP0,254)
	    CALL STRVRF (ISKIP)
	    IWRD = IWRD + 127
	    IBYTS = IBYTS - 256
	    GO TO 860
  870	  IF (IBYTS .EQ. 0)  GO TO 880
	    IBYTS = IBYTS-2
	    ISKIP = IOR (ISKIP0,IBYTS)
	    CALL STRVRF (ISKIP)
	    IWRD = IWRD + IBYTS/2
C
C...	INSERT CORRECT BYTE COUNT
  880	  IVBUF(KPTR+1) = NBKNT - 4
C
C...	CHECK IF ANY DATA
	  IF (NBKNT .NE. 4)  GO TO 885
	    IWRD = KPTR
	    NBKNT = 0
  885	  CONTINUE
C
C...	INSERT END-OF-FRAME IF NECESSARY
C
C...	NOTE: THE END-OF-FRAME, IF IT IS OUTPUT, MUST BE THE LAST
C	      DATA OUTPUT.  THEREFORE, ANY PADDING MUST PRECEDE IT.
C
	IF (KREP .EQ. 1 .AND. KTWO .EQ. 0) GO TO 890
	  CALL STRVRF ( 6147 )
	  CALL STRVRF ( 0 )
	  NBKNT = NBKNT + 4
C
C...	OUTPUT THE BLOCK
  890	  CALL OUTPUT (IVBUF(KPTR), NBKNT)
C
C
C...	SWITCH BUFFER POINTERS
	  I = KPTR
	  KPTR = INBUF2
	  INBUF2 = I
C
C...	CHECK IF PDQ FLAG SHOULD BE RESET
C	(CHECK IF A FORM FEED FOLLOWED THE LAST PLOT)
  900	IF (IPLOT .NE. KPLOT .AND. (IPLEN .NE. 0 .OR. IFFAP .LT. 0
     *	    .OR. (NCOPY .GT. 1 .AND. JSPACE .LT. 0)))  IPDQ = -1
C
	INTARG(1) = IPLOT
	IF (IPLOT .NE. KPLOT)  CALL OEOF
	IF (IPLOT .NE. KPLOT .AND. LSTCPY)  CALL MSGLG2 (8)
C
	GO TO (100, 120), KRTN
C
C
C...	ERROR, NO EOP CALL OR WRONG VERSION OF RANDOM FILE
 9000	IF (ITEMPL .NE. 0)  GO TO 9200
C
C...	NO END OF PLOT CALL
	  CALL MSGLG2 (1)
	  GO TO 9997
C
C...	WRONG VERSION OF FILE
 9200	CALL MSGLG2 (12)
	GO TO 9997
C
C...	DETACH OUTPUT DEVICE AND CLOSE DISK FILE
 9999	CALL OEOF
 9998	CALL DETACH
 9997	CALL RCLOS
C
	RETURN
C
	END
