SUBROUTINE BAND
C
C     NAME:  BAND
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     BAND - SORT THE VRF FILE
C
C     SUBROUTINE BAND SORTS THE 'RANDOM.RAN' DISK FILE GENERATED
C     BY THE PHASE I ROUTINES OF VERSAPLOT-RANDOM
C
C     THE BAND SUBROUTINE USES A RECURSIVE PARTITION-SORT
C     ALGORITHM. IF A BAND (PLOT) CONTAINS MORE THAN "MXELEM"
C     RANDOM ELEMENTS, THE BAND IS DIVIDED INTO "NBUFR" BANDS
C     AND A PARTITION-SORT IS DONE BASED ON THE MINIMUM X-VALUES
C     OF THE ELEMENTS. THIS SORT IS PERFORMED RECURSIVELY FOR
C     ANY BANDS EXCEEDING "MXELEM".
C
C     THIS VERSION OF SUBROUTINE BAND SUPPORTS BANDING OF PLOTS
C     GREATER THAN 13.65' IN LENGTH.  PHASE I ROUTINES MUST NOT
C     OUTPUT ANY ELEMENTS THAT CROSS 13.65' (OR MULTIPLES OF)
C     BOUNDARIES.
C
C     THE NEW CODE WILL BREAK UP THE PLOT INTO 13.65' BANDS
C     IF NECESSARY AND THEN BAND TO THE 50000 MAXIMUM ELEMENT
C     COUNT.
C
C     ENTRY:  CALL BAND
C
C     EXIT:   "RANDOM.RAN" FILE SORTED
C
C     CALLS:  RREAD,RWRIT,RWAIT,GETFRE,IBCHNK,
C             WCHUNK,IRAM,AND,OR
C
C     CALLED BY:  RANDOM
C
C     COMMON USED:
C     /IOCOM/
C            I LUNIT   - LOGICAL UNIT NUMBER OF LISTING DEVICE
C            I LREC    - LENGTH OF DATA FILE RECORD IN WORDS
C
C     /MSGCOM/
C            I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS
C
C     /BSORT/
C            I BEGIN   - ARRAY OF POINTERS TO BEGINNING OF
C                        EACH BAND OUTPUT BUFFER
C            I BYTCNT  - COUNT OF DATA IN RECORD FOR VRF HEADER
C            I CANSTX  - VRF HEADER
C            L EOF     - FLAG INDICATING END-OF-DATA IN BAND
C                        HAS BEEN REACHED
C            I FREMAX  - INDEX OF END OF FREE BUFFER
C            I FRENXT  - INDEX OF BEGINNING OF FREE BUFFER
C            I IBUF    - VRF INPUT BUFFER
C            I ISIZE   - DIMENSION OF IVBUF ARRAY
C            I MSKALL  - MASK WITH ALL BITS TURNED ON
C            I MAX     - ARRAY OF POINTERS TO END OF EACH
C                        OUTPUT BUFFER
C            I MAXI    - POINTER TO END OF INPUT BUFFER
C            I NCHUNK  - NUMBER OF 16-BIT CHUNKS PER OUTPUT WORD
C            I NEXTI   - POINTER TO INPUT BUFFER
C            I NEXTO   - ARRAY OF POINTERS TO CURRENT OUTPUT
C                        LOCATION WITHIN EACH BUFFER
C            I NXDREC  - ARRAY OF DISK RECORD INDICES WHERE EACH
C                        BAND OUTPUT BUFFER SHOULD BE WRITTEN.
C                        MAINTAINED FOR CHAINING PURPOSES.
C            I IVBUF   - ARRAY USED FOR SORT AND OUTPUT BUFFERS.
C            I PRECIS  - VRF PRECISION (16 OR 32-BIT)
C     /STKCOM/
C            I NEXTFR  - INDEX TO DISK RECORD IF FILE MUST BE
C                       EXTENDED
C            I NLOSTA  - NUMBER OF RECORDS LOST THAT WOULD NOT
C                       HAVE BEEN REUSED
C            I NLOSTB  - NUMBER OF RECORDS LOST THAT WOULD HAVE
C                       BEEN REUSED
C            I STKMAX  - MAXIMUM SIZE OF THE STACK
C            I STKPTR  - STACK POINTER
C            I VSTACK  - VIRTUAL STACK SIZE IF WE WERE USING
C                       AN UNLIMITED STACK
C            I MAXVS   - MAX. SIZE OF VSTACK
C            I VSUSED  - MAX. NUMBER OF STACK ENTRIES THAT WOULD
C                       HAVE BEEN USED ASSUMING AN UNLIMITED STACK
C
C     LOCAL VARIABLES USED:
C
C            I  BASEX  - CURRENT PLOT FONT BASELINE X-VALUE
C            I  BASEY  - CURRENT PLOT FONT BASELINE Y-VALUE
C            I  BEGBND - BEGIN BAND COMMAND
C            I  BEG16  - BEGIN BAND COMMAND (16-BIT PRECISION)
C            I  BEG32  - BEGIN BAND COMMAND (32-BIT PRECISION)
C            I  BRANGE - BAND RANGE FOR COMPUTING OUTPUT BAND
C            I  BVRF16 - BEGIN-VRF COMMAND FOR 16-BIT PRECISION
C            I  BVRF32 - BEGIN-VRF COMMAND FOR 32-BIT PRECISION
C             I  CAPTR  - POINTER TO THE CONTROL ARRAY
C            I  CURX   - CURRENT PLOT POSITION X-VALUE
C            I  CURY   - CURRENT PLOT POSITION Y-VALUE
C               I  DRWKNT - CURRENT BYTE COUNT FOR A DRAW
C            I  DRWMAX - BYTE COUNT FOR A DRAW WITH A PEN OF WIDTH
C                       GREATER THAN 1
C            I  DRWMIN - BYTE COUNT FOR A DRAW WITH A PEN OF WIDTH
C                       AT MOST 1
C            I  FONT   - CURRENT PLOT FONT NUMBER
C            I  HREC   - BAND HEADER RECORD NUMBER FOR CURRENT BAND
C            I  HT     - CHARACTER HEIGHT OF TEXT STRING
C            I  I      - TEMPORARY VARIABLE
C            I  IBAND  - DESTINATION BAND FOR A VRF COMMAND
C            I  IBSIZE - RASTER BUFFER SIZE OF AN RPM IN 16-BIT WORDS
C             I  IBYTES - THE BYTES/SCAN OF THE PLOTTER
C            I  IBYTS  - REMAINING BYTE COUNT USED FOR PADDING
C                        LEVEL I BUFFER
C            I  ICHNKS - REMAINING 16-BIT CHUNK COUNT USED FOR PADDING
C                        LEVEL II BUFFER
C            I  ICOM   - COMMAND INDEX
C            I  ICPCMD - COPY COMMAND FLAG WORD
C            I  ICUT   - PAPER CUT FLAG
C            I  IFF00  - MASK USED TO CHECK FOR BEGIN-BAND COMMAND
C            I  IHREC  - TEMPORARY HREC
C            I  IJREC  - TEMPORARY JREC
C            I  ILWM   - NEGATIVE OFFSET OF CURRENT PEN - KWIDTH/2
C            I  ILWP   - POSITIVE OFFSET OF PEN - (KWIDTH-1)/2
C            I  IPLEN  - PLOT LENGTH IN INCHES USED FOR COLOR PLOTTER
C            I  ISKIP  - SKIP COMMAND WITH COUNT
C            I  ISKIP0 - ZERO COUNT LEVEL I SKIP
C            I  ISKIP2 - ZERO COUNT LEVEL II SKIP
C               I  ISRTA  - SORT FLAG FOR ELEMENT/BYTE PARTITIONING
C               I  ISRTB  - SORT FLAG FOR EXTENDED (13.65') PARTITIONING
C               I  ITCHAR - TEMPORARY TEXT CHARACTER
C               I  ITCNT  - BYTE COUNT OF TEXT STRING
C            I  ITEMP  - TEMPORARY VARIABLE,USED TO STORE COMMAND CHUNK
C               I  ITNPLT - TEMPORARY PLOT NUMBER VARIABLE
C             I  ITONER - THE TONER NUMBER BEING USED
C            I  IX     - END POINT X-VALUE OF A VRF ELEMENT
C            I  IX1    - MINIMUM X-VALUE OF A VRF ELEMENT
C            I  IXMIN  - STARTING X-VALUE OF THE CURRENT BAND
C                           BEING SORTED
C            I  IY     - END POINT Y-VALUE OF A VRF ELEMENT
C            I  IY1    - Y VALUE OF DRAW COMMAND
C            I  J      - TEMPORARY VARIABLE
C               I  JTONER - TEMPORARY PLOT TONER VARIABLE
C            I  KSORT  - FLAG INDICATING WHETHER ANY PARTITIONS
C                       NEED TO BE RESORTED
C            I  KWIDTH - WIDTH OF CURRENT PEN - PENSIZ(PEN+1)
C               I  MASKC  - MASK FOR GETTING EACH CHARACTER
C            I  MAXXR  - MAXIMUM ALLOWABLE (RPM) PARTITION SIZE
C            I  MMAXXR - MINIMUM VALUE FOR MAXXR
C            I  MBIT16 - MSBIT (16-BIT PRECISION)
C            I  MBIT32 - MSBIT (32-BIT PRECISION)
C            I  MSBIT  - WORD WITH MOST-SIGNIFICANT BIT SET
C               I  MXBYTE - LARGEST BYTE COUNT OF A SORTED PARTITION
C               I  MXPART - LARGEST PARTITION SIZE OF SORTED PARTITION
C               I  NCHRS  - NUMBER OF CHARACTERS IN AUTHOR FIELD
C            I  NDTBND - NUMBER OF COLOR BANDS WITH ELEMENTS
C            I  NMBT16 - NMSBIT (16-BIT PRECISION)
C            I  NMBT32 - NMSBIT (32-BIT PRECISION)
C            I  NMSBIT - MASK TO ZERO MOST-SIGNIFICANT BIT OF A WORD
C            I  MXELEM - MAXIMUM NUMBER OF ELEMENTS PER BAND
C            I  NBUFR  - NUMBER OF OUTPUT BUFFERS USED IN SORT
C            I  NBUFRS - NUMBER OF OUTPUT BUFFERS AVAILABLE FOR SORT
C            I  NC     - NUMBER OF CHARACTERS IN TEXT-STRING COMMAND
C            I  NPARAM - NUMBER OF PARAMETER CHUNKS IN A COMMAND
C            I  NPTS   - NUMBER OF POINTS IN A DRAW-POLYGON COMMAND
C            I  NXBAND - BAND FOLLOWING CURRENT BAND BEING SORTED
C            I  PEN    - CURRENT PLOT PEN
C            I  PFONT  - INDEX INTO CHRKNT TABLE FOR CURRENT FONT
C            R  PMSIZE - THE RPM MEMORY SIZE (IN BYTES)
C               I  PSIZE  - THE RPM MEMORY CAPACITY (IN BYTES)
C               I  RDEN   - NIBS/INCH OF THE PLOTTER
C            I  SETFBL - SET-FONT-BASELINE COMMAND
C            I  SETFNT - SET-FONT COMMAND
C            I  SETPEN - SET-PEN COMMAND
C               I  STROKC - NUMBER OF STROKES FOR A CHARACTER
C            I  VRFHGT - VRF HEIGHT OF BAND TO BE SORTED
C            I  XMIN   - STARTING X-VALUE OF THE CURRENT BAND
C                           BEING SORTED
C
C     LOCAL ARRAYS USED:
C            I  BBASEX - CURRENT BAND FONT-BASELINE X-VALUE
C            I  BBASEY - CURRENT BAND FONT-BASELINE Y-VALUE
C            I  BCURX  - CURRENT BAND POSITION X-VALUE
C            I  BCURY  - CURRENT BAND POSITION Y-VALUE
C            I  BFONT  - CURRENT BAND FONT NUMBER
C            I  BPEN   - CURRENT BAND PEN
C             I  BYTKNT - NUMBER OF BYTES IN A BAND
C               I  CHRKNT - NUMBER OF STROKES EACH CHARACTER TAKES
C            I  DHEAD  - FIRST DATA RECORD IN EACH BAND CHAIN
C             I  IAUTHR - AUTHOR TEXT STRING
C               I  IPRISM - CONTROL ARRAY
C            R  NELEM  - NUMBER OF ELEMENTS IN BAND
C
C
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 /BSORT/ -  BANDING VARIABLES
C
      INTEGER NEXTI,PRECIS,CANSTX,BYTCNT,FREMAX,FRENXT
      INTEGER BEGIN,NEXTO,MAX,NXDREC,MAXI,NCHUNK,MSKALL
      INTEGER IBUF,IVBUF
      LOGICAL EOF
C
      COMMON /BSORT/
     *    NEXTI, PRECIS, EOF, CANSTX, BYTCNT,
     *    MAXI,  NCHUNK, FREMAX, FRENXT, IWRD, NBYTS, KPTR,
     *    ISIZE, MSKALL, BEGIN(74), NEXTO(74), MAX(74),
     *    NXDREC(74), IST2, IBUF(128), IVBUF(9600)
C
C
C
C
C...  COMMON /STKCOM/ - DISK RECORD ALLOCATION STACK VARIABLES
C
      INTEGER NEXTFR,STKPTR,STKMAX,STACK
      INTEGER VSTACK,MAXVS,VSUSED,NLOSTA,NLOSTB
C
      COMMON /STKCOM/
     *    NEXTFR,STKPTR,STKMAX,VSTACK,MAXVS,VSUSED,
     *    NLOSTA,NLOSTB,STACK(1000)
C
C
      INTEGER B13SIZ
      INTEGER NBUFR,NBUFRS
      INTEGER SETPEN,IFF00,BEGBND,BVRF16,BVRF32,SETFBL,SETFNT
      INTEGER HREC,VRFHGT,BRANGE,NPARAM,ICOM,IXMIN,XMIN
      INTEGER PEN,BASEX,BASEY,FONT,CURX,CURY,PFONT
      INTEGER ISKIP0,ISKIP2,MSBIT,NMSBIT
      INTEGER IBAND,IBYTS,ICHNKS,ISKIP,IX,IX1,IY,IY1
      INTEGER J,NC,NPTS,NXBAND,TMPCAP
      INTEGER BEG16,MBIT16,NMBT16,PSIZE,RDEN
      INTEGER CAPTR,MXBYTE,MXPART,DRWKNT,DRWMAX,DRWMIN,WIDLIN
      INTEGER BEG32,MBIT32,NMBT32
C
      INTEGER DHEAD(74),BPEN(74),BFONT(74),BCURX(74)
      INTEGER BCURY(74),BBASEX(74),BBASEY(74)
      INTEGER BSIZE(74)
      INTEGER PENSIZ(64)
      INTEGER POLYX(128),POLYY(128)
      INTEGER BYTKNT(74),IAUTHR(30),IDAT(256)
      REAL PMSIZE
      DIMENSION CHRKNT(128,6)
      DIMENSION CH1KNT(128),CH2KNT(128),CH3KNT(128)
      DIMENSION CH4KNT(128),CH5KNT(128),CH6KNT(128)
      EQUIVALENCE (CHRKNT(1,1),CH1KNT(1))
      EQUIVALENCE (CHRKNT(1,2),CH2KNT(1))
      EQUIVALENCE (CHRKNT(1,3),CH3KNT(1))
      EQUIVALENCE (CHRKNT(1,4),CH4KNT(1))
      EQUIVALENCE (CHRKNT(1,5),CH5KNT(1))
      EQUIVALENCE (CHRKNT(1,6),CH6KNT(1))
C
      INTEGER IPRISM(128)
C
      INTEGER NELEM(74),MXELEM,VRFKNT
C
C
C...  RPM RASTER BUFFER SIZE - 256K 16-BIT WORDS
      DATA IBSIZE/262144/
C
      DATA NBUFRS/74/
C
C...       MSBIT/'8000'X/, NMSBIT/'7FFF'X/
      DATA MSBIT/32768/,   NMSBIT/32767/
C
C...       SETPEN/'8301'X/,IFF00/'FF00'X/,BEGBND/'8101'X/
      DATA SETPEN/33537/,  IFF00/65280/,  BEGBND/33025/
C
C...       ISKIP0/'C000'X/,ISKIP2/'8C00'X/,SETFBL/'8B02'X/
      DATA ISKIP0/49152/,  ISKIP2/35840/,  SETFBL/35586/
C
C...       SETFNT/'8A01'X/
      DATA SETFNT/35329/
C
C...       BEG16/'8101'X/,MBIT16/'8000'X/,NMBT16/'7FFF'X/
      DATA BEG16/33025/,  MBIT16/32768/,  NMBT16/32767/
C
C...       BEG32/'8102'X/,MBIT32/'80000000'X/,NMBT32/'7FFFFFFF'X/
      DATA BEG32/33026/,  MBIT32/-2147483648/,NMBT32/2147483647/
C
C...       BVRF16/'8300'X/,BVRF32/'8400'X/
      DATA BVRF16/33536/,  BVRF32/33792/
C
C...       MSKUP/'FFFF8000'X/
      DATA MSKUP/-32768/
      DATA B13SIZ/32768/
      DATA MASKC/127/, DRWKNT/ 8/, DRWMIN/8/, DRWMAX/12/
C
C    TABLE OF THE NUMBER OF STROKES IT TAKES TO DRAW
C    EACH CHARACTER IN THE CHARACTER TABLE.
C
C    THIS TABLE IS FOR THE DEFAULT FONT.
C
      DATA  CH1KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3.,
     +                9., 6., 5., 3., 7., 1., 1., 0., 2., 3.,
     +                4., 0., 3., 3., 1., 0., 1., 7., 5., 2.,
     +                5.,10., 0., 4., 6.,10.,11., 9., 9., 3.,
     +                3., 3., 4., 2., 5., 1., 4., 1., 8., 3.,
     +                8.,12., 3., 9.,10., 4.,15.,10., 8., 9.,
     +                2., 2., 2.,11.,15., 7.,11., 7., 6., 5.,
     +                4.,10., 3., 3., 5., 3., 2., 4., 3., 9.,
     +                6., 9., 7.,12., 2., 5., 2., 4., 2., 3.,
     +                4., 3., 1., 3., 2., 1., 8., 8., 8., 3.,
     +                9., 9., 7., 0., 8., 4.,13.,11., 0., 0.,
     +                0., 0., 4., 9., 3., 3., 3., 3., 3., 1.,
     +                5., 4., 0., 0., 4., 2., 4., 4./
C
C    2ND FONT - SIMPLEX
C
      DATA  CH2KNT /0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     +                0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     +                0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     +                0., 0., 0., 5., 2., 4.,21.,26.,33., 1.,
     +                9., 9., 3., 2., 7., 1., 4., 1.,16., 3.,
     +               13.,14., 3.,16.,22., 2.,28.,22., 8.,11.,
     +                2., 2., 2.,17.,25., 3.,18.,17.,12., 4.,
     +                3.,19., 3., 1., 9., 3., 2., 4., 3.,20.,
     +               10.,21.,11.,19., 2., 9., 2., 4., 2., 3.,
     +                3., 4., 1., 4., 7., 1., 3.,14.,14.,13.,
     +               14.,16., 5.,19., 7., 5., 8., 3., 1.,13.,
     +                7.,16.,14.,14., 5.,16., 5., 7., 2., 4.,
     +                2., 6., 3.,34., 1.,34.,12., 0./
C
C    3RD FONT - FRENCH
C
      DATA  CH3KNT /0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     +                0., 0., 0., 0., 0., 0.,16.,15.,15.,30.,
     +               18.,17.,17.,32.,18., 3.,17.,18.,32., 9.,
     +                8.,23., 0., 5., 2., 4.,21.,26.,33., 1.,
     +                9., 9., 3., 2., 7., 1., 4., 1.,16., 3.,
     +               13.,14., 3.,16.,22., 2.,28.,22., 8.,11.,
     +                2., 2., 2.,17.,25., 3.,18.,17.,12., 4.,
     +                3.,19., 3., 1., 9., 3., 2., 4., 3.,20.,
     +               10.,21.,11.,19., 2., 9., 2., 4., 2., 3.,
     +                3., 4., 1., 4., 7., 1., 3.,14.,14.,13.,
     +               14.,16., 5.,19., 7., 5., 8., 3., 1.,13.,
     +                7.,16.,14.,14., 5.,16., 5., 7., 2., 4.,
     +                2., 6., 3.,34., 1.,34.,12., 0./
C
C    4TH FONT - SWEDISH
C
      DATA  CH4KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3.,
     +                9., 6., 5., 3., 7., 1., 1., 0., 2., 3.,
     +                4., 0., 3., 3., 1., 0., 1., 7., 5., 2.,
     +                5.,10., 0., 4., 6.,10.,11., 9., 9., 3.,
     +                3., 3., 4., 2., 5., 1., 4., 1., 8., 3.,
     +                8.,12., 3., 9.,10., 4.,15.,10., 8., 9.,
     +                2., 2., 2.,11.,15., 7.,11., 7., 6., 5.,
     +                4.,10., 3., 3., 5., 3., 2., 4., 3., 9.,
     +                6., 9., 7.,12., 2., 5., 2., 4., 2., 3.,
     +                4.,15.,16.,11.,13., 1., 8., 8., 8., 3.,
     +                9., 9., 7., 0., 8., 4.,13.,11., 0., 0.,
     +                0., 0., 4., 9., 3., 3., 3., 3., 3., 1.,
     +                5., 4., 0., 0., 4., 2., 4., 4./
C
C    5TH FONT - GERMAN
C
      DATA  CH5KNT /5., 9., 4., 2., 2., 5., 4., 3., 4., 3.,
     +                8., 4., 4., 1., 7., 1., 1., 0., 8., 3.,
     +               19., 0., 3., 3., 8., 0., 6., 3., 3., 1.,
     +               10., 6., 0., 5., 2., 4.,12.,17.,14., 1.,
     +                5., 5., 4., 2., 2., 1., 4., 1.,12., 2.,
     +                8.,13., 3., 9.,13., 3.,23.,13., 8., 6.,
     +                2., 2., 2.,11.,18., 3.,13., 7., 8., 4.,
     +                3., 9., 3., 1., 4., 3., 2., 4., 3.,12.,
     +                8.,13., 9.,13., 2., 7., 2., 4., 2., 3.,
     +                3.,11.,20.,15., 2., 1., 1., 9., 8., 7.,
     +                8.,11., 4.,11., 5., 5., 7., 3., 1., 6.,
     +                5.,12., 8., 8., 4.,11., 2., 5., 2., 4.,
     +                2., 3., 3.,17.,20.,13.,10., 7./
C
C    6TH FONT - NORWEGIAN
C
      DATA  CH6KNT /7.,11., 5., 3., 3., 6., 6., 5., 8., 3.,
     +                9., 6., 5., 3., 7., 1., 1., 0., 2., 3.,
     +                4., 0., 3., 3., 1., 0., 1., 7., 5., 2.,
     +                5.,10., 0., 4., 6.,10.,11., 9., 9., 3.,
     +                3., 3., 4., 2., 5., 1., 4., 1., 8., 3.,
     +                8.,12., 3., 9.,10., 4.,15.,10., 8., 9.,
     +                2., 2., 2.,11.,15., 7.,11., 7., 6., 5.,
     +                4.,10., 3., 3., 5., 3., 2., 4., 3., 9.,
     +                6., 9., 7.,12., 2., 5., 2., 4., 2., 3.,
     +                4., 6., 9.,11., 2., 1., 8., 8., 8., 3.,
     +                9., 9., 7., 0., 8., 4.,13.,11., 0., 0.,
     +                0., 0., 4., 9., 3., 3., 3., 3., 3., 1.,
     +                5., 4., 0., 0., 4., 2., 4., 4./
C
C
C
C
      EOF = .FALSE.
C
C...  READ IN FILE HEADER RECORD
      CALL RREAD (IBUF(1),1)
      CALL RWAIT
C
C...  GET MAX BAND SIZE FROM PHASE I
      MXELEM = IBUF(3)
      IF (MXELEM .LE. 0)  MXELEM = 1
C-I
      CALL MSGLG2(2)
C-I
C
C... SET PLOT HEADER POINTER TO SECOND RECORD.
      HREC = 2
C
C...  GET THE BYTE COUNT OF THE DATA IN THE RECORD
      BYTCNT = 2 * NCHUNK * (LREC-1) - 4
      NEXTFR = IBUF(1) + 1
      STKPTR = 0
      CANSTX = 6146
      STKMAX = 1000
      VSTACK = 0
      MAXVS = 0
      VSUSED = 0
      NLOSTA = 0
      NLOSTB = 0
      MAXI = LREC*NCHUNK
C
C... GET KREP AND KTWO
      KREP = IBUF(6)
      KTWO = IBUF(21)
C
C... GET THE NIBS/INCH AND BYTES/SCAN
      RDEN = IBUF(11)
      IBYTES = IBUF(12)
C
C... CHECK IF BYTES PER SCAN TOO LARGE
      NDKNT = 1
      IF (IBYTES .GE. 2048) NDKNT = 2
C
C...  GET THE DISK FLAG
      IDISK = IBUF(19)
C
C... GET THE AVAILABLE MEMORY SIZE IN BYTES FOR EACH PARTITION,
C    CONVERT TO A REAL NUMBER
      PMSIZE = IBUF(22)
C
C...  SET FIRST PASS FLAG FOR HEADER CHECK
      IFIRST = 0
C
C...  ALLOCATE THE BANDING BUFFERS
C     CHECK IF SUFFICIENT SPACE ALLOCATED
      IF (LREC*(NBUFRS+1).LE.ISIZE) GO TO 100
C-E
      CALL MSGLG2(3)
      GO TO 98888
C-E
C
C...  INITIALIZE BUFFER POINTERS
  100 ITEMP = 1
      DO 200 I=1,NBUFRS
         BEGIN(I) = ITEMP
         ITEMP = ITEMP + LREC
         MAX(I) = MAXI
  200 CONTINUE
C
C...  INITIALIZE THE PREVIOUS PLOT AND TONER NUMBERS
      ITNPLT = -1
      JTONER = -1
C
      FRENXT = ITEMP
      FREMAX = MAXI
C
C...  DETERMINE MMAXXR - THE MINIMUM ALLOWABLE VALUE FOR MAXXR.
C     WE WANT THE LARGEST POSSIBLE VALUE WE CAN USE FOR A PARTITION
C     SIZE THAT STILL GIVES US THE MAXIMUM POSSIBLE RPM MEMORY
C     CAPACITY.  (FOR ANY SMALLER VALUE, THE CAPACITY STAYS THE SAME)
C     THIS VALUE IS TWICE THE BAND SIZE. (SEE THE RPM CAPACITY
C     CALCULATION IN FUNCTION RPMCAP.)
C     THE FOLLOWING CALCULATION SHOULD BE THE SAME AS IN FUNCTION
C     RPMCAP.
C
      JTEMP = (IBYTES+1)/2
      JTEMP = 16 * ((JTEMP+15)/16)
      JTEMP = IBSIZE / JTEMP
      JTEMP = JTEMP / 2
      N = 1
  210 IF (N .GT. JTEMP) GO TO 220
        N = N + N
        GO TO 210
  220 JTEMP = N
      IF (JTEMP .GT. 2048) JTEMP = 2048
      MMAXXR = JTEMP * 2
C
C     ******************
C...  * PROCESS A BAND *
C     ******************
C
C...  READ BAND HEADER RECORD
  300 IF (HREC.EQ.0) GO TO 90000
      CALL RREAD (IBUF(1),HREC)
      CALL RWAIT
C
C...  CHECK IF NULL PLOT HEADER RECORD
      IJREC = IBUF(1)
      IHREC = IBUF(3)
      IF (IJREC .EQ. 0 .AND. IHREC .EQ. 0)  GO TO 90000
C
C...  DOES BAND NEED TO BE SORTED?
      ISRTA = IBUF(2)
      ISRTB = IBUF(10)
      IF ((ISRTA.NE.0).OR.(ISRTB.NE.0)) GO TO 400
C
C... DO NOT NEED TO SORT THIS RECORD GET THE NEXT
      HREC = IHREC
      GO TO 300
C
C     *****************
C...  * SORT THE BAND *
C     *****************
C
C...  FIRST SAVE BAND HEADER INFO
  400 JREC = IBUF(1)
      NXBAND = IBUF(3)
      XMIN = IBUF(4)
      CAPTR = IBUF(5)
      NPLOT = IBUF(6)
      NCOPY = IBUF(7)
      VRFKNT = IBUF(8)
      IBXMAX = IBUF(9)
      IPLEN = IBUF(11)
      NDTBND = IBUF(12)
      ITONER = IBUF(13)
      NCHRS = IBUF(14)
      DO 410 K = 1,15
  410   IAUTHR(K) = IBUF(14+K)
      IBKNT = IBUF(30)
      ICPCMD = IBUF(31)
      ICUT = IBUF(32)
      JBXMAX = IBUF(33)
C
C...  CHECK THE PLOT NUMBER AND TONER. IF IT'S A NEW PLOT OR TONER
C     WE RESET THE MAX BYTE COUNT AND PARTITION SIZE.
C     WE ALSO CALCULATE A NEW MAXIMUM PARTITION SIZE FOR AN RPM.
        IF (NPLOT .EQ. ITNPLT .AND. ITONER .EQ. JTONER) GO TO 420
        ITNPLT = NPLOT
        JTONER = ITONER
        MXBYTE = 0
        MXPART = 0
        IF (KREP .EQ. 1 .AND. KTWO .EQ. 0)  GO TO 414
C
C...    CALCULATE A NEW MAXIMUM PARTITION SIZE BASED ON THE LENGTH
C       OF THE PLOT AND THE TOTAL BYTE COUNT.  USING THIS, WE
C       CALCULATE THE PRISM MEMORY CAPACITY.
        MAXXR = IBXMAX + 1
 412      MAXXR = (MAXXR + 1) / 2
          NBUF0 = (IBXMAX + MAXXR) / MAXXR
          IF (MAXXR .GT. MMAXXR) GO TO 413
            MAXXR = MMAXXR
            PSIZE = 0.5 * RPMCAP (IBYTES,MAXXR,1,PMSIZE)
C
C...        CHECK IF MEMORY SIZE IS TOO SMALL
            IF (PSIZE .GT. 0)  GO TO 414
             CALL MSGLG2(16)
             GO TO 98888
C
 413      PSIZE = 0.5 * RPMCAP (IBYTES,MAXXR,1,PMSIZE)
          IF ((IBKNT * 2) .GT. (PSIZE * NBUF0))  GO TO 412
 414    CONTINUE
C
C...  READ FIRST DATA RECORD
 420  IF (JREC .NE. 0)  GO TO 440
C
C...  NO DATA RECORD, READ NEXT HEADER
      HREC = NXBAND
      GO TO 300
C
C...  READ THE CONTROL ARRAY
  440   IF (CAPTR .EQ. 0) GO TO 445
        CALL RREAD (IPRISM(1),CAPTR)
      CALL RWAIT
C
C... SAVE THE CONTROL ARRAY POINTER
      TMPCAP = CAPTR
      WIDLIN = IPRISM(11)
      JDISK = IPRISM(15)
      DRWMAX = 12
      IF (WIDLIN .EQ. 1) DRWMAX = 14
C
C... READ THE FIRST DATA RECORD
  445   CALL RREAD (IBUF(1),JREC)
      CALL RWAIT
C
C... CHECK FOR VALID VDS HEADER IF FIRST PASS
      IF (IFIRST .NE. 0) GO TO 450
      IFIRST = IFIRST + 1
C
C... CHECK FOR AN '1802' AND BYTE COUNT VALUE
      IF ((IRAM(IBUF(2),16,65535) .EQ. 6146) .AND.
     *              (AND(IBUF(2),65535) .NE. 0)) GO TO 450
C
C... INVALID HEADERS, OUTPUT MESSAGE AND STOP
C-E
      CALL MSGLG2(4)
C-E
      GO TO 98888
C
C... CONTINUE PROCESSING FILE
  450 CONTINUE
      NEXTI = 3
      IXMIN = XMIN
C
C     CALCULATE NUMBER OF BUFFERS NEEDED BASED ON THE SORT FLAG.
C     IF SORTING FOR A REP USE ELEMENTS, IF SORTING FOR A RPM USE
C...  BYTES AND IF BOTH USE THE GREATER OF THE TWO.
      IF (ISRTB .NE. 0)  GO TO 490
      NBUF1 = 0
      NBUF2 = 0
      IF (ISRTA .NE. 1 .AND. ISRTA .NE. 3) GO TO 455
C
C...    CALCULATE NUMBER OF BUFFERS REQUIRED FOR A REP
        NBUF1 = (2 * VRFKNT / MXELEM) + 1
C
  455 IF (ISRTA .LT. 2) GO TO 485
C
C...    CALCULATE NUMBER OF BUFFERS REQUIRED FOR AN RPM
C
C...    NUMBER OF BUFFERS BASED ON BYTE COUNT
        NBUF2 = (2 * IBKNT / PSIZE) + 1
C
C...    NUMBER OF BUFFERS BASED ON PARTITION SIZE
        VRFHGT = IBXMAX - XMIN + 1
        NBUF3 = (VRFHGT + MAXXR - 1) / MAXXR
C
C...    TAKE MAXIMUM
        IF (NBUF3 .GT. NBUF2) NBUF2 = NBUF3
C
C...  TAKE MAXIMUM OF THE NUMBER OF BUFFERS REQUIRED
  485 NBUFR = NBUF1
      IF (NBUF2 .GT. NBUF1) NBUFR = NBUF2
      IF (NBUFR .LT. 2) NBUFR = 2
      IF (NBUFR .LE. NBUFRS)  GO TO 490
C
C...    NEED MORE BUFFERS, INFORM THE USER.
        INTARG(1) = NBUFR
        INTARG(2) = NBUFRS
        CALL MSGLG2(18)
        NBUFR = NBUFRS
C
C...  INITIALIZE FIRST BUFFER AND SET UP POINTERS FOR FIRST BAND
 490  DHEAD(1) = JREC
      NXDREC(1) = JREC
      NEXTO(1) = 3
      CALL RWAIT
C
C...  COPY INPUT TO FIRST BUFFER UNTIL 'BEGIN-BAND' COMMAND
  510 CALL IBCHNK (IDAT,1,0)
      ITEMP = IDAT(1)
      IF (ITEMP.EQ.BEGBND) GO TO 550
      IF (ITEMP.NE.BVRF32) GO TO 520
      PRECIS = 32
      DRWMIN = 12
      BEGBND = BEG32
      MSBIT = MBIT32
      NMSBIT = NMBT32
      GO TO 525
  520 IF (ITEMP.NE.BVRF16) GO TO 530
      BEGBND = BEG16
      MSBIT = MBIT16
      NMSBIT = NMBT16
      PRECIS = 16
      DRWMIN = 8
C
C...  INITIALIZE PEN WIDTHS TO DEFAULT VALUES FOR START OF PLOT
C...    THE MAXIMUM PEN WIDTH IS 31 NIBS.
  525 DO 528 I = 1,32
         PENSIZ(I) = I - 1
  528 CONTINUE
      DO 529 I = 33,64
         PENSIZ(I) = 31
  529   CONTINUE
  530 CALL WBCHNK (1,IDAT,1,0)
      GO TO 510
C
C...  CHECK EXTENDED-BANDING FLAG
  550 IF (ISRTB.EQ.0) GO TO 600
C
C...  GET BAND SIZE AND CALCULATE NO. OF EXTENDED BANDS
      CALL IBCHNK (IDAT,1,-1)
      VRFHGT = IBXMAX - XMIN + 1
      VRFHGT = VRFHGT - B13SIZ + 8
      NBUFR = ((VRFHGT + B13SIZ - 1)/B13SIZ) + 1
      IF (NBUFR.LE.NBUFRS) GO TO 560
C
      INTARG(1)=NBUFR
      CALL MSGLG2(5)
      GO TO 98888
C
  560 BSIZE(1) = B13SIZ - 8
      BRANGE = B13SIZ
      IXMIN = -8
      I = 2
      GO TO 700
C
C...  GET OLD BAND SIZE AND CALCULATE NEW BAND SIZES
  600 CALL IBCHNK (IDAT,1,-1)
      VRFHGT = IBXMAX - XMIN + 1
      BRANGE = VRFHGT/NBUFR
      IF (BRANGE*NBUFR.LT.VRFHGT) BRANGE = BRANGE + 1
      IF (VRFHGT.LT.NBUFR) NBUFR = VRFHGT
C
      I = 1
  700 IF ((I.EQ.NBUFR).OR.(VRFHGT.LE.BRANGE)) GO TO 800
      BSIZE(I) = BRANGE
      VRFHGT = VRFHGT - BRANGE
      I = I + 1
      GO TO 700
  800 BSIZE(I) = VRFHGT
      NBUFR = I
C
C...  INITIALIZE OUTPUT BUFFERS,POINTERS, AND VARIABLES
      DO 900 II = 1,NBUFR
             III = II
             IF (III.EQ.1) GO TO 850
             CALL GETFRE (JREC)
             DHEAD(III) = JREC
             NXDREC(III) = JREC
             NEXTO(III) = 3
              IDAT(1) = CANSTX
              IDAT(2) = BYTCNT
             CALL WBCHNK (III,IDAT,2,0)
  850        BPEN(III) = -1
             BFONT(III) = -1
             BCURX(III) = -1
             BCURY(III) = -1
             BBASEX(III) = 0
             BBASEY(III) = 0
             NELEM(III) = 0
              BYTKNT(III) = 0
              IDAT(1) = BEGBND
             CALL WBCHNK (III,IDAT,1,0)
              IDAT(1) = BSIZE(III)
             CALL WBCHNK (III,IDAT,1,-1)
  900 CONTINUE
C
C
C...  RESET PLOT PARAMETERS TO DEFAULTS
      PEN = 1
      KWIDTH = 1
      ILWM = 0
      ILWP = 0
      DRWKNT = DRWMIN
      BASEX = 200
      BASEY = 0
      FONT = 0
      PFONT = 1
      CURX = 0
      CURY = 0
C
C
C     *************
C...  * SORT LOOP *
C     *************
C
C...  GET COMMAND CHUNK
 1000 CALL IBCHNK (IDAT,1,0)
      ITEMP = IDAT(1)
      IF (EOF) GO TO 2500
C
C...  IS IT A POSITIONING COMMAND?
      IF (AND(ITEMP,MBIT16).EQ.0) GO TO 1200
C
C...  SEPARATE COMMAND INTO INDEX AND NUMBER OF DATA CHUNKS
      ICOM = IRAM(ITEMP,8,127)
      NPARAM = AND(ITEMP,255)
C
C...  IS IT A VALID COMMAND?
      IF (ICOM.LE.13) GO TO 1100
C-E
      INTARG(1)=ICOM
      CALL MSGLG2(6)
      GO TO 98888
C-E
C
C...  GO TO APPROPRIATE COMMAND PROCESSING ROUTINE
 1100 IDX = ICOM+1
      GO TO (2000,89000,3000,4000,89000,89000,
     X         89000,5000,6000,7000,8000,9000,2500,10000),IDX
C
C
C     ***********************
C...  * POSITIONING COMMAND *
C     ***********************
C
 1200 IX = ITEMP
      IF (PRECIS.EQ.16) GO TO 1300
      CALL IBCHNK(IDAT,1,0)
      ITEMP = IDAT(1)
      IX = ITEMP + IRAM(IX,-16,MSKALL)
 1300 CALL IBCHNK (IDAT,1,-1)
      IY = IDAT(1)
C
C...  IS IT A MOVE COMMAND?
      IF (AND(IY,MSBIT).EQ.0) GO TO 1700
C
C...  NO, ITS A DRAW COMMAND
      IY1 = AND (IY,NMSBIT)
      IX1 = MIN0 (CURX,IX)
      IF (IABS(CURX-IX).LT.IABS(CURY-IY1)) IX1 = IX1 - ILWM
      IBAND = (IX1-IXMIN)/BRANGE + 1
      IF (IBAND.LE.0) IBAND=1
C
C...  CHECK CURRENT PEN
      IF (BPEN(IBAND).EQ.PEN) GO TO 1400
      BPEN(IBAND) = PEN
      IDAT(1) = SETPEN
      IDAT(2) = PEN
      CALL WBCHNK (IBAND,IDAT,2,0)
C
C...  CHECK CURRENT POSITION
 1400 IF (CURX.NE.BCURX(IBAND)) GO TO 1500
      IF (CURY.EQ.BCURY(IBAND)) GO TO 1600
 1500   IDAT(1) = CURX
      IDAT(2) = CURY
      IDAT(3) = IX
      IDAT(4) = IY
      CALL WBCHNK (IBAND,IDAT,4,-1)
      GO TO 1650
 1600   IDAT(1) = IX
      IDAT(2) = IY
      CALL WBCHNK (IBAND,IDAT,2,-1)
 1650 IY = IY1
      BCURX(IBAND) = IX
      BCURY(IBAND) = IY
C
C   COUNT THE NUMBER OF ELEMENTS
      NELEM(IBAND) = NELEM(IBAND) + NDKNT
C
C... COUNT THE NUMBER OF BYTES
      BYTKNT(IBAND) = BYTKNT(IBAND) + DRWKNT
C
C...  UPDATE CURRENT POSITION
 1700 CURX = IX
      CURY = IY
      GO TO 1000
C
C
C     *******************
C...  * END-VRF COMMAND *
C     *******************
 2000   IDAT(1) = ITEMP
      CALL WBCHNK (NBUFR,IDAT,1,0)
C
C...  OUTPUT ANY LEVEL I COMMANDS TO LAST BUFFER
 2100 CALL IBCHNK (IDAT,1,0)
      ITEMP = IDAT(1)
      IF (EOF) GO TO 2200
      IF (AND(ITEMP,IFF00).EQ.ISKIP0) GO TO 2200
      CALL WBCHNK (NBUFR,IDAT,1,0)
      GO TO 2100
C
C...  PAD BUFFER CONTAINING END-VRF COMMAND WITH LEVEL I SKIPS
C     FIRST CALCULATE REMAINING BYTE COUNT
 2200 IBYTS = (MAX(NBUFR)-NEXTO(NBUFR)+1)*2
C
C...  CHECK FOR FULL BUFFER
      IF (IBYTS.LE.0) GO TO 2500
C
C...  INSERT SKIP COMMANDS
 2300 IF (IBYTS.LE.256) GO TO 2400
      ISKIP = OR (ISKIP0,254)
      IDAT(1) = ISKIP
      CALL WBCHNK (NBUFR,IDAT,1,0)
      NEXTO(NBUFR) = NEXTO(NBUFR) + 127
      IBYTS = IBYTS - 256
      GO TO 2300
C
C...  INSERT LAST SKIP COMMAND
 2400 ISKIP = OR (ISKIP0,IBYTS-2)
      IDAT(1) = ISKIP
      CALL WBCHNK (NBUFR,IDAT,1,0)
      NEXTO(NBUFR) = MAX(NBUFR) + 1
C
C...  FLUSH ALL BUFFERS
 2500 DO 2900 II=1,NBUFR
         III=II
         ICHNKS = MAX(III) - NEXTO(III) + 1
C
C...  CHECK FOR FULL BUFFER
         IF (ICHNKS.LE.0) GO TO 2800
C
C...  INSERT LEVEL II SKIP COMMANDS
 2600    IF (ICHNKS.LE.256) GO TO 2700
         ISKIP = OR (ISKIP2,255)
         IDAT(1) = ISKIP
         CALL WBCHNK (III,IDAT,1,0)
         NEXTO(III) = NEXTO(III) + 255
         ICHNKS = ICHNKS - 256
         GO TO 2600
C
C...  INSERT LAST LEVEL II SKIP COMMAND
 2700    ISKIP = OR (ISKIP2,ICHNKS-1)
         IDAT(1) = ISKIP
         CALL WBCHNK (III,IDAT,1,0)
C
C...  SET RECORD POINTER TO NULL
 2800    J = BEGIN(III)
         IVBUF(J) = 0
C
C...  OUTPUT THE BUFFER
         CALL RWAIT
         CALL RWRIT (IVBUF(BEGIN(III)),NXDREC(III))
C
 2900 CONTINUE
      CALL RWAIT
C
C...  INITIALIZE SORT FLAG
      KSORT = 0
C
C...  OUTPUT HEADER RECORDS
      ITEMP = HREC
      DO 2950 I=1,NBUFR
         IBUF(1) = DHEAD(I)
         IBUF(2) = 0
         IF (ISRTA .EQ. 0) GO TO 2925
C
C    CHECK THE SORT FLAG. ISRTA = 1 IS A REP, ISRTA = 2 IS PRISM
C... AND ISRTA = 3 MEANS UNKNOWN SORT FOR BOTH REP AND PRISM.
         IF (ISRTA .NE. 1) GO TO 2920
         IF (NELEM(I).LE.MXELEM) GO TO 2925
         IF (BRANGE.EQ.1) GO TO 2910
         IBUF(2) = 1
         GO TO 2925
C-I
C
C...     PLOT SORTED TO SCAN SIZE OF 1, CHECK IF DISK
 2910    IF (IDISK .EQ. 1 .OR. IDISK .EQ. 3)  GO TO 2925
         CALL MSGLG2(7)
         GO TO 98888
C-I
C
C    CHECK THE SORT FLAG. IF ITS EQUAL TO 2 SORT BY BYTES.
C    CHECK THE NUMBER OF BYTES IN THE PARTITION. IF ITS MORE THAN
C    PSIZE SET THE FLAG FOR THE PARTITION TO BE REPARTITIONED.
C    IF THE PARTITION SIZE IS TOO LARGE, REPARTITION.
C
 2920      IF (ISRTA .NE. 2) GO TO 2922
           IF (BYTKNT(I).LE.PSIZE .AND. BSIZE(I).LE.MAXXR) GO TO 2925
         IF (BRANGE .EQ. 1) GO TO 2921
         IBUF(2) = 2
         GO TO 2925
C
C
C...     PLOT SORTED TO SCAN SIZE OF 1, CHECK IF DISK
 2921    IF (JDISK .EQ. 3 .OR. JDISK .EQ. 4)  GO TO 2925
         CALL MSGLG2(7)
         GO TO 98888
C
C... THE SORT FLAG IS 3 WHICH MEANS SORT FOR BOTH A REP AND A PRISM.
 2922      IF (NELEM(I).LE.MXELEM .AND. BYTKNT(I).LE.PSIZE
     *              .AND. BSIZE(I) .LE. MAXXR)GO TO 2925
         IF (BRANGE .EQ. 1) GO TO 2923
         IBUF(2) = 3
         GO TO 2925
C
C...     PLOT SORTED TO SCAN SIZE OF 1, CHECK IF DISK
 2923    IF ((IDISK .EQ. 1 .OR. IDISK .EQ. 3) .AND.
     *              (JDISK .EQ. 3 .OR. JDISK .EQ. 4) )  GO TO 2925
         CALL MSGLG2(7)
         GO TO 98888
C
C...     IF PARTITION NEEDS RESORTING, SET SORT FLAG
 2925    IF (IBUF(2) .EQ. 0)  GO TO 2926
            KSORT = 1
            GO TO 2927
C
C...     THE PARTITION IS SORTED, UPDATE MAX BYTE COUNT AND
C        MAX PARTITION RANGE
 2926       IF (BYTKNT(I) .GT. MXBYTE) MXBYTE = BYTKNT(I)
            IF (BSIZE(I) .GT. MXPART) MXPART = BSIZE(I)
C
 2927           IF (I.NE.NBUFR) GO TO 2930
         JREC = NXBAND
         GO TO 2940
 2930    CALL GETFRE (JREC)
 2940    IBUF(3) = JREC
         IBUF(4) = XMIN
         IBUF(5) = CAPTR
         CAPTR = 0
         IBUF(6) = NPLOT
         IBUF(7) = NCOPY
         IBUF(8) = NELEM(I)
         XMIN = XMIN + BSIZE(I)
         IBUF(9) = XMIN - 1
         IBUF(10) = 0
         IBUF(11) = IPLEN
         IBUF(12) = NDTBND
         IBUF(13) = ITONER
         IBUF(14) = NCHRS
         DO 2945 K = 1,15
 2945        IBUF(14+K) = IAUTHR(K)
         IBUF(30) = BYTKNT(I)
         IBUF(31) = ICPCMD
         IBUF(32) = ICUT
         IBUF(33) = JBXMAX
C
         CALL RWRIT (IBUF(1),ITEMP)
         ITEMP = JREC
         CALL RWAIT
 2950 CONTINUE
      EOF = .FALSE.
C
C...  IF ANY PARTITIONS NEED TO BE RESORTED, DON'T BOTHER WITH
C     THE CONTROL ARRAY, IT WILL GET DONE LATER ANYWAY
      IF (KSORT .NE. 0)  GO TO 300
C
C...  ONLY UPDATE CONTROL ARRAY IF RPM OUTPUT
      IF (KREP .EQ. 1 .AND. KTWO .EQ. 0)  GO TO 300
C
      IF (MXBYTE .GT. PSIZE .AND. JDISK .EQ. 4) JDISK = 3
      IPRISM(3) = MXBYTE
      IPRISM(4) = MXPART
      IPRISM(6) = 1
      IPRISM(15) = JDISK
      CALL RWRIT(IPRISM(1),TMPCAP)
      CALL RWAIT
C
      GO TO 300
C
C
C     **************
C...  * DEFINE PEN *
C     **************
C...  OUTPUT THE COMMAND
 3000 CALL WBCHNK (1,IDAT,1,0)
C
C...  GET AND OUTPUT THE PEN INDEX
      CALL IBCHNK (IDAT,1,0)
      IP = IDAT(1)
      CALL WBCHNK (1,IDAT,1,0)
C
C...  GET AND OUTPUT THE DASH PATTERN
      CALL IBCHNK (IDAT,4,-1)
      CALL WBCHNK (1,IDAT,4,-1)
C
C...  GET THE PEN WIDTH
      CALL IBCHNK (IDAT,1,0)
      PENSIZ(IP+1) = IDAT(1)
      CALL WBCHNK (1,IDAT,1,0)
C
C...  CHECK IF CURRENT PEN BEING DEFINED
      IF (IP .NE. PEN)  GO TO 1000
      KWIDTH = PENSIZ(PEN+1)
      ILWM = KWIDTH/2
      ILWP = (KWIDTH-1)/2
      GO TO 1000
C
C
C     ***********
C...  * SET PEN *
C     ***********
C...  GET THE PEN NUMBER AND UPDATE THE GLOBAL PEN NUMBER
 4000 CALL IBCHNK (IDAT,1,0)
      PEN = IDAT(1)
      KWIDTH = PENSIZ(PEN+1)
      ILWM = KWIDTH/2
      ILWP = (KWIDTH-1)/2
      DRWKNT = DRWMIN
      IF (KWIDTH .EQ. 0) DRWKNT = 0
      IF (KWIDTH .GT. 1) DRWKNT = DRWMAX
      GO TO 1000
C
C
C     ***********************
C...  * DEFINE FILL-PATTERN *
C     ***********************
C...  OUTPUT THE COMMAND
 5000 CALL WBCHNK (1,IDAT,1,0)
C
C...  OUTPUT THE COMMAND PARAMETERS
      CALL IBCHNK (IDAT,NPARAM,0)
      CALL WBCHNK (1,IDAT,NPARAM,0)
C
C...  COUNT BYTES FOR RPM
      BYTKNT(1) = BYTKNT(1) + 2 * IDAT(4)
C
      GO TO 1000
C
C
C     ****************
C...  * DRAW POLYGON *
C     ****************
C
C...  COMPUTE NUMBER OF POINTS IN POLYGON
 6000 NPTS = (NPARAM-1)/2
      IF (PRECIS.EQ.32) NPTS = NPTS/2
C
C...  READ IN THE POLYGON
C     FIRST READ FILL-PATTERN INDEX
      CALL IBCHNK (IDAT,1,0)
      IFILL = IDAT(1)
C
C...  INITIALIZE FIRST POINT
      POLYX(1) = CURX
      POLYY(1) = CURY
C
C...  NOW READ IN THE VERTICES
      NP1 = NPTS + 1
        NWDS = 2*NP1 - 2
      CALL IBCHNK (IDAT,NWDS,-1)
      J = 1
      DO 6100 I=2,NP1
         POLYX(I) = IDAT(J)
         J = J + 1
         POLYY(I) = IDAT(J)
         J = J + 1
 6100 CONTINUE
C
C...  FIND MIN X POINT
      K = 1
      IX = POLYX(1)
      DO 6110 I = 2,NP1
         IF (POLYX(I) .GE. IX)  GO TO 6110
         K = I
           IX = POLYX(I)
 6110 CONTINUE
C
C...  DETERMINE IF FILL ONLY (NO OUTLINE)
      IOUTLN = 0
      IF (AND(POLYY(NPTS),MSBIT).EQ.0) GO TO 6400
C
C...  OUTLINE SPECIFIED, INIT. INDICES TO END-POINTS OF LINE
 6200 KM1 = K - 1
      IF (KM1 .LE. 0)  KM1 = NPTS
      KP1 = K + 1
      IF (KP1 .GT. NPTS)  KP1 = 1
      IOUTLN = 1
C
C...  CHECK IF FIRST LINE IS Y-MAJOR
      IY1 = AND(POLYY(KP1),NMSBIT)
      IF (IABS(IX-POLYX(KP1)).LT.IABS(IY-IY1)) GO TO 6300
C
C...  CHECK IF LAST LINE IS Y-MAJOR
      IY1 = AND(POLYY(KM1),NMSBIT)
      IF (IABS(IX-POLYX(KM1)).GE.IABS(IY-IY1))  GO TO 6400
C
C...  CORRECT FOR Y-MAJOR LINE
 6300 IX = IX - ILWM
C
C...  CALCULATE OUTPUT BAND
 6400 CONTINUE
      IBAND = (IX-IXMIN)/BRANGE + 1
      IF (IBAND.LE.0) IBAND=1
C
C...  CHECK CURRENT PEN
      IF (IOUTLN .EQ. 0) GO TO 6500
      IF (BPEN(IBAND).EQ.PEN) GO TO 6500
      BPEN(IBAND) = PEN
      IDAT(1) = SETPEN
      IDAT(2) = PEN
      CALL WBCHNK (IBAND,IDAT,2,0)
C
C...  CHECK CURRENT POSITION
 6500 IF (CURX.NE.BCURX(IBAND)) GO TO 6600
      IF (CURY.EQ.BCURY(IBAND)) GO TO 6700
 6600   IDAT(1) = CURX
      IDAT(2) = CURY
      CALL WBCHNK (IBAND,IDAT,2,-1)
C
C...  UPDATE NUMBER OF ELEMENTS IN BAND
 6700 IF (IOUTLN .EQ. 0) NPTS = NPTS + 1
      NELEM(IBAND) = NELEM(IBAND) + NPTS + 1
C
C    UPDATE THE NUMBER OF BYTES IN THE BAND. CHECK FOR
C    THE SPECIAL CASES WHERE THE POLYGON IS NOT FILLED AND
C... IF THE POLYGON IS OUTLINED.
      BYTKNT(IBAND) = BYTKNT(IBAND) + 8 + 4*NPTS
      IF (IOUTLN .NE. 0) BYTKNT(IBAND) = BYTKNT(IBAND) + DRWKNT*NPTS
C
C...  OUTPUT THE POLYGON
      IDAT(1) = ITEMP
      IDAT(2) = IFILL
      CALL WBCHNK (IBAND,IDAT,2,0)
      J = 1
      DO 6800 I=2,NP1
         IDAT(J) = POLYX(I)
         J = J + 1
         IDAT(J) = POLYY(I)
         J = J + 1
 6800 CONTINUE
      CALL WBCHNK (IBAND,IDAT,NWDS,-1)
C
C...  UPDATE CURRENT POSITION WITHIN BAND
      BCURX(IBAND) = CURX
      BCURY(IBAND) = CURY
      GO TO 1000
C
C
C     ***************
C...  * TEXT STRING *
C     ***************
C...  GET NUMBER OF CHARACTERS
 7000 CALL IBCHNK (IDAT,1,0)
      NC = IDAT(1)
C
C...  CALCULATE ENDING POSITION OF TEXT STRING
      IX = BASEX * NC/8 + CURX
      IY = BASEY * NC/8 + CURY
C
C...  DETERMINE THE X-ORDINATES OF THE BOUNDING RECTANGLE
      IXB1 = CURX - (BASEX - BASEY)/21
      IXB2 = IXB1 + (BASEX * NC)/8 + (5*BASEX)/42
      IXB3 = IXB2 - (41*BASEY)/168
      IXB4 = IXB1 - (41*BASEY)/168
C
C...  FIND MINIMUM X-COORDINATE OF TEXT STRING
      IX1 = MIN0(IXB1,IXB2,IXB3,IXB4) - ILWM
C
C...  CALCULATE OUTPUT BAND
      IBAND = (IX1-IXMIN)/BRANGE + 1
      IF (IBAND.LE.0)IBAND=1
C
C...  CHECK CURRENT FONT
      IF (BFONT(IBAND).EQ.FONT) GO TO 7050
      BFONT(IBAND) = FONT
      IDAT(1) = SETFNT
      IDAT(2) = FONT
      CALL WBCHNK (IBAND,IDAT,2,0)
C
C...  CHECK CURRENT FONT BASELINE
 7050 IF (BBASEX(IBAND).NE.BASEX) GO TO 7100
      IF (BBASEY(IBAND).EQ.BASEY) GO TO 7200
 7100 ICOM = SETFBL
      IF (PRECIS.EQ.32) ICOM = ICOM + 2
      IDAT(1) = ICOM
      CALL WBCHNK (IBAND,IDAT,1,0)
      IDAT(1) = BASEX
      IDAT(2) = BASEY
      CALL WBCHNK (IBAND,IDAT,2,-1)
      BBASEX(IBAND) = BASEX
      BBASEY(IBAND) = BASEY
C
C...  CHECK CURRENT POSITION
 7200 IF (CURX.NE.BCURX(IBAND)) GO TO 7300
      IF (CURY.EQ.BCURY(IBAND)) GO TO 7400
 7300   IDAT(1) = CURX
      IDAT(2) = CURY
      CALL WBCHNK (IBAND,IDAT,2,-1)
C
C...  CHECK CURRENT PEN
 7400 IF (BPEN(IBAND).EQ.PEN) GO TO 7500
      BPEN(IBAND) = PEN
      IDAT(1) = SETPEN
      IDAT(2) = PEN
      IDAT(3) = ITEMP
      IDAT(4) = NC
      CALL WBCHNK (IBAND,IDAT,4,0)
      GO TO 7550
C
C...  OUTPUT THE COMMAND
 7500   IDAT(1) = ITEMP
      IDAT(2) = NC
      CALL WBCHNK (IBAND,IDAT,2,0)
C
 7550 NPARAM = NPARAM - 1
C
C GET EACH CHARACTER AND LOOK UP HOW MANY STROKES EACH
C CHARACTER TAKES TO DRAW.
C
      ITCNT = 0
      NCHAR = 0
        CALL IBCHNK (IDAT,NPARAM,0)
      DO 7600 I=1,NPARAM
         ITCNT = ITCNT + DRWKNT *
     *              CHRKNT(AND(IDAT(I)/256,MASKC)+1,PFONT)
         NCHAR = NCHAR + 1
         IF (NCHAR .EQ. NC) GO TO 7600
         ITCNT = ITCNT + DRWKNT*CHRKNT(AND(IDAT(I),MASKC)+1,PFONT)
         NCHAR = NCHAR + 1
 7600 CONTINUE
      CALL WBCHNK (IBAND,IDAT,NPARAM,0)
C
C...  UPDATE THE CURRENT POSITION
      CURX = IX
      CURY = IY
      BCURX(IBAND) = IX
      BCURY(IBAND) = IY
C
C...  UPDATE NUMBER OF ELEMENTS IN BAND
      NELEM(IBAND) = NELEM(IBAND) + ((NC-1)/4) + 4
C
C... UPDATE THE NUMBER OF BYTES IN THE BAND
      BYTKNT(IBAND) = BYTKNT(IBAND) + ITCNT
      GO TO 1000
C
C
C     ************
C...  * SET FONT *
C     ************
C...  GET THE FONT NUMBER
 8000 CALL IBCHNK (IDAT,1,0)
      FONT = IDAT(1)
      PFONT = 1
      IF (FONT .GE. 15 .AND. FONT .LE. 19) PFONT = FONT - 13
      GO TO 1000
C
C
C     *********************
C     * SET FONT-BASELINE *
C     *********************
 9000 CALL IBCHNK (IDAT,2,-1)
      BASEX = IDAT(1)
      BASEY = IDAT(2)
      IF (PRECIS.EQ.32) GO TO 1000
      IF (BASEX.LT.32767) GO TO 9100
      BASEX = OR (BASEX,MSKUP)
 9100 IF (BASEY.LT.32767) GO TO 9200
      BASEY = OR (BASEY,MSKUP)
 9200 GO TO 1000
C
C
C     ***************
C...  * DRAW CIRCLE *
C     ***************
C
C...  GET PATTERN NUMBER
10000 CALL IBCHNK (IDAT,2,0)
      IPAT = IDAT(1)
C
C...  GET LINE WIDTH
      IWIDTH = IDAT(2)
C
C...  GET RADIUS
      CALL IBCHNK (IDAT,1,-1)
      IRAD = IDAT(1)
C
C...  CALCULATE MINIMUM X-VALUE OF CIRCLE
      IX = CURX - IRAD - IWIDTH/2
      IBAND = (IX-IXMIN)/BRANGE + 1
      IF (IBAND.LE.0) IBAND=1
C
C...  CHECK CURRENT POSITION
      IF (CURX.NE.BCURX(IBAND)) GO TO 10100
      IF (CURY.EQ.BCURY(IBAND)) GO TO 10200
10100   IDAT(1) = CURX
      IDAT(2) = CURY
      CALL WBCHNK (IBAND,IDAT,2,-1)
      BCURX(IBAND) = CURX
      BCURY(IBAND) = CURY
C
C...  OUTPUT THE CIRCLE COMMAND
10200   IDAT(1) = ITEMP
      IDAT(2) = IPAT
      IDAT(3) = IWIDTH
      CALL WBCHNK (IBAND,IDAT,3,0)
      IDAT(1) = IRAD
      CALL WBCHNK (IBAND,IDAT,1,-1)
C
C...  UPDATE NUMBER OF ELEMENTS IN BAND
      NELEM(IBAND) = NELEM(IBAND) + 2
C
C     UPDATE THE BYTE COUNT. CHECK FOR THE CIRCLE THAT
C...  IS OUTLINED AND FILLED.
      ICCNT = 12
      IF (IWIDTH .NE. 0) ICCNT = 24
      BYTKNT(IBAND) = BYTKNT(IBAND) + ICCNT
      GO TO 1000
C
C
C     **************************
C...  * UNRECOGNIZABLE COMMAND *
C     **************************
C
C-I
89000 INTARG(1)=ICOM
      CALL MSGLG2(6)
C-I
C
C...  SKIP OVER THE PARAMETERS
      CALL IBCHNK (IDAT,NPARAM,0)
      GO TO 1000
C
C
C     *********************
C...  * END OF PROCESSING *
C     *********************
C
C...  OUTPUT THE FILE HEADER RECORD
90000 CALL RWAIT
      CALL RREAD (IBUF(1),1)
      CALL RWAIT
C
C...  OUTPUT MAX ELEMENT FOR BAND
      IBUF(3) = MXELEM
C
C...  SET FLAG TO INDICATE FILE HAS BEEN SORTED
      IBUF(2) = 0
C
C...  OUTPUT SIZE OF FILE
      IBUF(1) = NEXTFR - 1
C
C... OUTPUT KREP,KTWO,RDEN & IBYTES
      IBUF(6) = KREP
      IBUF(11) = RDEN
      IBUF(12) = IBYTES
      IBUF(21) = KTWO
C
C... OUTPUT PRISM MEMORY SIZE
      IBUF(22) = INT(PMSIZE)
C
      CALL RWRIT (IBUF(1),1)
C
C-I
      CALL MSGLG2(9)
C-I
C
C...  CHECK IF ANY LOST RECORDS
      INTARG(1) = NLOSTB
      INTARG(2) = STKMAX
      INTARG(3) = VSUSED
      IF (NLOSTB .GT. 0) CALL MSGLG2(14)
C
C...  RETURN
99999 CALL RWAIT
      RETURN
C
98888 CONTINUE
      CALL RCLOS
      STOP
C
      END