C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

      SUBROUTINE POST

c read frame skip parameter from unit 21 (if it is there)
c     READ(21,*,ERR=10,END=10) IFRAM
c     CALL FRMSKP(IFRAM)

c call postprocessor loop routine
10    CALL PPLOOP
      RETURN
      END

      SUBROUTINE PPLOOP
C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C

C LOOP             - LOOP THROUGH BGP FILE, CALLING VDI EQUIVALENTS

C P. WATTERBERG    - 25 OCT 81
C P. L. CROTTY     -  4 APR 85 - UPDATETO INCLUDE POLYGON FILL (PLC)
C K. Cole          - 05 oct 90 - added SAVE

C ENVIRONMENT      -COMPUTER-INDEPENDENT, SYSTEM-INDEPENDENT, FORTRAN 77

C ENTRY CONDITIONS - VDI has been initialized by calling VDINIT.

C CALLS            - Most of the VDI routines.

C EXIT CONDITIONS  -

C NARRATIVE        - SCAN A BGP FILE, PICKING OFF OPCODES AND OPERANDS.
C                    MAKE A CALL TO THE EQUIVALENT VDI ROUTINE.
C                    THE OPCODE IS USED AS AN INDEX INTO A JUMP TABLE OF
C                    A COMPUTED GOTO.

C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C

C          VARIABLES THAT DON'T HAVE ANYTHING TO DO WITH COLOR

      SAVE
      INTEGER OPCODE, COUNT, TEXT(132), ESNUMB(100)
      INTEGER NUMESC, IFRAM
      REAL ARGS(2000)
      LOGICAL EOFOK, NOEOF, MARKER, TWODIM, FICHE, START, DOFISH
C (PLC)
      REAL XARRAY(508),YARRAY(508)

C          DESCRIPTION OF THE ABOVE VARIABLES

C OPCODE      - When a BGP opcode is expected, the next 8 bits from the BGP
C               file are read into OPCODE.  OPCODE-127 is then used as an index
C               into a jump table.  Also, may be the first eight bits of an
C               X coordinate.
C COUNT       - The next 8 bits after the opcode which is the word count for
C               the opcode.  May be the second eight bits of an X coordinate.
C TEXT(132)   - When a text string command is seen, the text is read
C               into TEXT one character or 8 bits at a time.  This means that
C               TEXT will contain ascii characters, one per word, right
C               justified and zero filled, just what VDTEXT needs.
C ESNUMB(100) - Is a list of known VDI escape codes with numeric arguments.
C NUMESC      - The number of elements in
C IFRAM       - Draws every Ith frame.
C ARGS(2000)  - A real array to hold the arguments of the escape code.
C EOFOK       - Always .TRUE.  When requesting the next few bits from the file,
C               it is passed to the retrieval routine, PPBTR, to let it know
C               that an end of file is ok at this point.
C NOEOF       - Always .FALSE. When requesting the next few bits from the file,
C               it is passed to the retrieval routine, PPBTR, to let it know
C               that an end of file here is illegal.
C MARKER      - True when marker plot mode has been selected, false otherwise.
C TWODIM      - True when two dimensional coordinate mode is in effect and
C               false when in three dimensional mode.
C FICHE       - True when the device that is being post processed to will
C               handle the VDI fiche break escape.
C START       - True for the first file id command then false.
C DOFISH      - True if the VDI fiche break escape should be called rather than
C               a VDNWPG.
C (PLC)
C XARRAY,YARRAY-Real arrays to pass x,y coordinates to polygon routine (VDPOLY)

C          VARIABLES TO HANDLE COLOR

      INTEGER NEXTFC, NEXTBC
      INTEGER CSPOT, INDICES(256), NXTDEX
      INTEGER NUMCLR, COLMAP(0:255), INVMAP(0:255)
      REAL RGB(3,256), TABLE(3,0:255), VECTOR(7)
      LOGICAL BATCH, DRAWN, FIRST

C          DESCRIPTION OF THE ABOVE VARIABLES

C TABLE(3,0:255) - This is used for holding the color table as the meta file
C                  thinks it is.  The device may not have all 256 colors that
C                  the meta file has, so we can't just ship the color calls
C                  down to the device.
C COLMAP(0:255)  - This is the mapping from TABLE to the devices real color
C                  table.  COLMAP(n) is -1 if color n in TABLE has not been
C                  sent to the device yet.  If color n in TABLE has been
C                  defined at the device, then COLMAP(n) is the color number
C                  in the devices real table.  The basic idea is that when the
C                  device only has 8 colors, the user will get the first eight
C                  colors that are used in each frame.
C INVMAP(0:255)  - This is the inverse map from the devices real color table
C                  to TABLE.  Like COLMAP, INVMAP(n) is -1 if the link has not
C                  been established.
C NXTDEX         - The next position in the devices color table that has not
C                  been used.  That is, the next slot in INVMAP that is -1.
C NUMCLR         - The number of colors that the device can support.
C NEXTFC         - The color that the next primitive should be drawn in.
C NEXTBC         - The background color that should be used for the next VDNWPG
C BATCH          - True when in the middle of a batch update
C                - of the color table.
C RGB(3,256)     - When doing a batch update of the color table, this array is
C                  used to hold the color entries which can be sent to the
C                  device, i.e. those entries for which COLMAP is not -1.
C INDICES(256)    - The color table indexes associated with the entries in RGB.
C CSPOT          - The next open spot in RGB and INDICES.
C VECTOR(7)      - Used to find out the default foregound and background
C                  colors from VDIQOS and to reinitialize the system at a
C                  new file id.
C DRAWN          - True if something has been drawn since inititalization or
C                  the background color has changed from default.
C FIRST          - True until after the first newpage since initialization

C          NON COLOR DATA STATEMENTS

      DATA NUMESC   /     58  /
      DATA (ESNUMB(I),I=1,58)
     +  / 99, 100, 101, 200, 201, 202, 203, 204, 205, 206,
     +   206, 208, 209, 210, 211, 212, 213, 214, 215, 216,
     +   302, 400, 401, 402, 501, 502, 600, 601, 700, 701,
     +   702, 703, 704, 705, 706, 707, 708, 900, 1020, 1021,
     +   1022, 1023, 1024, 1025, 1026, 1400, 1505, 1506,1507,
     +   1508, 1509, 1510, 1700, 2100, 2101, 2300, 2305, 2306 /
      DATA DOFISH   / .FALSE. /
      DATA EOFOK    /  .TRUE. /
      DATA NOEOF    / .FALSE. /
      DATA FICHE    / .FALSE. /
      DATA START    /  .TRUE. /
      DATA IFRAM    /      1  /
      DATA IFCOUN   /      0  /
      DATA COUNT    /      0  /
      GOTO 80000

      ENTRY FRMSKP(IFRMS)
      IFRAM = IFRMS
      RETURN

80000 CONTINUE

C          MAIN LOOP TO PROCESS FILE

C          THROW AWAY UNUSED WORDS OF THE PREVIOUS INSTRUCTION
C            (NOTE: first time through count is 0)

    1 DO 2 I=1,COUNT
         CALL PPBTR(16,OPCODE,NOEOF)
    2 CONTINUE

C          GET NEXT INSTRUCTION OR MOVE/DRAW

    3 CALL PPBTR(8,OPCODE,EOFOK)
      CALL PPBTR(8,COUNT,EOFOK)

c          If just starting up, check for file id (84HEX=132)
C            or escape (82HEX=130)

      IF (START) THEN
         IF (OPCODE.NE.132.AND.OPCODE.NE.130) THEN
            PRINT 10010
10010       FORMAT(1X,
     +        'NO FILE ID PRESENT, POST PROCESSING TERMINATING.')
            RETURN
         ENDIF
      ENDIF

C          CHECK FOR MOVE OR DRAW

      IF(OPCODE.GE.128) GOTO 20
          XCOORD = DBLE(256*OPCODE+COUNT)*SCALE
          CALL PPBTR(8,OPCODE,NOEOF)
          CALL PPBTR(8,COUNT,NOEOF)
          IF(.NOT.TWODIM) CALL PPBTR(16,OPCODE,NOEOF)

C          IF WE ARE SKIPPING THIS FRAME THEN DON'T DO ANYTHING

          IF(IFCOUN.NE.0) GOTO 3

C          IF OPCODE < 128 THEN MOVE, ELSE DRAW A POINT OR LINE

          IF(OPCODE.LT.128) THEN
              YCOORD = DBLE(256*OPCODE+COUNT)*SCALE
              CALL VDMOVA(XCOORD,YCOORD)
            ELSE

C          MAKE SURE THE COLOR WE WANT HAS BEEN SET UP

              IF(COLMAP(NEXTFC).EQ.-1) THEN
                  INVMAP(NXTDEX) = NEXTFC
                  COLMAP(NEXTFC) = NXTDEX
                  CALL VDSTFC(NXTDEX)
                  CALL VDSTCO(1,NXTDEX,TABLE(1,NEXTFC),0)

C          SEARCH FOR THE NEXT UNUSED ENTRY IN INVMAP

    4             NXTDEX = NXTDEX + 1
                  IF(INVMAP(NXTDEX).NE.-1) GOTO 4
                  ENDIF

C          OK, MAKE A SMUDGE OF SOME SORT

              DRAWN = .TRUE.
              YCOORD = DBLE(256*(OPCODE-128)+COUNT)*SCALE
              IF(MARKER) THEN
                  CALL VDPNTA(XCOORD,YCOORD)
                ELSE
                  CALL VDLINA(XCOORD,YCOORD)
                ENDIF
            ENDIF
          GOTO 3

C          WE HAVE AN OPCODE, SO BRANCH TO APPROPRIATE CODE

   20 IF(OPCODE.EQ.133) THEN
         IFCOUN = IFCOUN + 1
         IF(IFCOUN.EQ.IFRAM) IFCOUN = 0
         ENDIF
      IF(IFCOUN.NE.0.AND.OPCODE.NE.134) GOTO 1
      GOTO (
     +     1,    1,  300,  400,  500,  600,  700,    8,    8, 1000,
C         80    81    82    83    84    85    86    87    88    89

     +     8,    8,    8,    8,    8,    8, 1700, 1800, 1900, 2000,
C         8A    8B    8C    8D    8E    8F    90    91    92    93

     +     8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
C         94    95    96    97    98    99    9A    9B    9C    9D

     +     8,    8, 3300, 3400, 3500, 3600, 3700,    1,    3,    3,
C         9E    9F    A0    A1    A2    A3    A4    A5    A6    A7

     +  4100, 4200, 4400,    8,    8,    8,    8,    8, 4900,    1,
C         A8    A9    AA    AB    AC    AD    AE    AF    B0    B1

     +  5100,    1,    1,    1,    8,    8,    8,    8,    8,    8,
C         B2    B3    B4    B5    B6    B7    B8    B9    BA    BB

     +     8,    8,    8,    8, 6500, 6600, 6700, 6800, 6900, 7000,
C         BC    BD    BE    BF    C0    C1    C2    C3    C4    C5

     +     1, 7200, 7300,    8,    8,    8,    8,    8,    8,    8,
C         C6    C7    C8    C9    CA    CB    CC    CD    CE    CF

     +     8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
C         D0    D1    D2    D3    D4    D5    D6    D7    D8    D9

     +     8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
C         DA    DB    DC    DD    DE    DF    E0    E1    E2    E3

     +     8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
C         E4    E5    E6    E7    E8    E9    EA    EB    EC    ED

     +     8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
C         EE    EF    F0    F1    F2    F3    F4    F5    F6    F7

     +     8,    8,    8,    8,    8,    8,    8,    8), OPCODE-127
C         F8    F9    FA    FB    FC    FD    FE    FF

C          82 -- ESCAPE CODES

  300 CALL PPBTR(8,OPCODE,NOEOF)
      CALL PPBTR(8,ICOUNT, NOEOF)
      COUNT = COUNT - 1
      IF(OPCODE.NE.1) GOTO 1

C          IT'S A VDI ESCAPE SO GET THE ESCAPE CODE

      CALL PPBTR(16,OPCODE,NOEOF)
      COUNT = COUNT - 1

C          CHECK TO SEE IF IT IS A KNOWN NUMERIC ESCAPE

      DO 310 I=1, NUMESC
         IF(OPCODE.EQ.ESNUMB(I)) GOTO 320
  310 CONTINUE
      GOTO 340

C          GET THE NUMERIC ARGUMENTS

  320 ISTOP = MIN0(COUNT,2000)
      DO 330 I=1, ISTOP/2
         CALL PPBTR(16,INTEGR,NOEOF)
         CALL PPBTR(16,IFRACT,NOEOF)
         IF(INTEGR.GE.32768) THEN
               ARGS(I) = -(DBLE(INTEGR-32768) + IFRACT/32768.)
            ELSE
               ARGS(I) = DBLE(INTEGR) + IFRACT/32768.
            ENDIF
  330 CONTINUE
      GOTO 350

C          IS IT A KNOWN ALHPA ESCAPE?

  340 CONTINUE
      GOTO 1

  350 CALL VDESCP(OPCODE,ISTOP/2,ARGS)
      COUNT = COUNT - ISTOP
      GOTO 1

C          83 -- ASPECT RATIO DEFINITION

  400 CALL PPBTR(16,IXDIM,NOEOF)
      CALL PPBTR(16,IYDIM,NOEOF)
      CALL PPBTR(16, JUNK,NOEOF)
      SCALE = AMIN1(XMAX/IXDIM,YMAX/IYDIM)
      GOTO 3

C          84 -- NEW FILE ID SO REINITIALIZE EVERYTHING
C          IF FIRST FILE ID, THEN DO ALL THE ONE TIME INITIALIZATION STUFF

  500 IF (START) THEN
c         CALL VBPKG('POST    ')
         CALL VDINIT(0.,5)
         CALL VDFRAM(0)

C          FIND OUT MAXIMUM X AND Y
C          USED TO SCALE BGP COORDINATES TO NDC COORDINATES

         CALL VDIQND(XMAX,YMAX)

C          FIND OUT DEFAULT FOREGROUND AND BACKGROUND COLORS

         CALL VDIQOS(VECTOR)
         NEXTFC = VECTOR(1)
         NEXTBC = VECTOR(2)

C          FIND OUT THE NUMBER OF COLORS IN THE COLOR TABLE

         INDEXA = 4
         CALL VDIQDC(4,DUMMY)
         NUMCLR = DUMMY

C          FIND OUT IF WE CAN USE FICHE BREAKS

         CALL VDIQES(211,IANS)
         IF(IANS.EQ.2) FICHE = .TRUE.
      ENDIF
      CSPOT = 1
      DRAWN = .FALSE.
      FIRST = .TRUE.
      MARKER = .FALSE.
      TWODIM = .TRUE.
      BATCH  = .FALSE.
      SCALE = AMIN1(XMAX/32767.,YMAX/32767.)

C          RE-ESTABLISH DEFAULT COLOR TABLE

      DO 510 I=0,255
         COLMAP(I) = I
         TABLE(1,I) = 1.
         TABLE(2,I) = 1.
         TABLE(3,I) = 1.
  510 CONTINUE
      TABLE(1,0) = 0.
      TABLE(2,0) = 0.
      TABLE(3,0) = 0.
      TABLE(2,1) = 0.
      TABLE(3,1) = 0.
      TABLE(1,2) = 0.
      TABLE(3,2) = 0.
      TABLE(3,3) = 0.
      TABLE(1,4) = 0.
      TABLE(2,4) = 0.
      TABLE(2,5) = 0.
      TABLE(1,6) = 0.
      IF(.NOT.START) THEN
         CALL VDWAIT

C          DELETE ALL SEGMENTS

         CALL VDESCP(203,1,0.)

C          REESTABLISH DEFAULT SETTINGS

         CALL VDSTOS(VECTOR)
         CALL VDSTCO(255,COLMAP,TABLE,0)
         CALL VDNWPG
         CALL VDMOVA(0.,0.)
         ENDIF
      START = .FALSE.
      NXTDEX = 256

C          IF THE DEVICE HAS LESS THAN 250 COLORS, THEN
C          SET UP THE MAPPINGS SO THAT THE USER WILL GET THE FIRST
C          FEW COLORS THEY ASK FOR.

      IF(NUMCLR.LE.250) THEN
         DO 520 I=0,255
            INVMAP(I) = -1
            COLMAP(I) = -1
  520    CONTINUE
         NXTDEX = 0
         IF(NEXTBC.EQ.0) NXTDEX = 1
         COLMAP(NEXTBC) = NEXTBC
         ENDIF
      NEXTFC = VECTOR(1)
      NEXTBC = VECTOR(2)
      GOTO 1

C          85 -- NEW PAGE

C          IF NOTHING HAS BEEN DRAWN, THEN DON'T CALL FOR A NEW PAGE.

  600 IF(FIRST.AND..NOT.DRAWN) GOTO 1
      FIRST = .FALSE.
      CALL VDWAIT

C          RESET THE COLOR MAPS SO THE USER CAN GET A NEW SET FOR NEXT FRAM

      IF(NUMCLR.LT.250) THEN
         DO 610 I= 0, 255
            COLMAP(I) = -1
            INVMAP(I) = -1
  610    CONTINUE
         COLMAP(NEXTBC) = 0
         CALL VDSTCO(1,0,TABLE(1,NEXTBC),0)
         NXTDEX = 1
         ENDIF
      CALL VDSTBC(COLMAP(NEXTBC))
      IF(DOFISH) THEN
            CALL VDESCP(211,0,0.)
         ELSE
            CALL VDNWPG
         ENDIF
      DOFISH = .FALSE.
      GOTO 1

C          86 -- END OF DATA FILE

  700 CALL VDWAIT
      CALL VDFRAM(1)
      CALL VDTERM
      RETURN

C          89 -- FICHE BREAK

 1000 DOFISH = FICHE
      GOTO 600

C          90 -- DEFINE COLOR TABLE INDEX

 1700 CALL PPBTR(16,INDEX,NOEOF)
      CALL PPBTR(16,IR,NOEOF)
      CALL PPBTR(8,IG,NOEOF)
      CALL PPBTR(8,IY,NOEOF)
      CALL PPBTR(8,IB,NOEOF)
      CALL PPBTR(8,IM,NOEOF)
      CALL PPBTR(8,IC,NOEOF)
      CALL PPBTR(8,IW,NOEOF)
      TABLE(1,INDEX) = AMIN1(IR/256.+IY/256.+IM/256.+IW/256.,1.)
      TABLE(2,INDEX) = AMIN1(IG/256.+IY/256.+IC/256.+IW/256.,1.)
      TABLE(3,INDEX) = AMIN1(IB/256.+IC/256.+IM/256.+IW/256.,1.)

C          IF THE LINK HAS ALREADY BEEN ESTABLISHED, THEN WE MAY WANT TO
C          CHANGE THE COLOR DYNAMICALLY.

      IF(COLMAP(INDEX).NE.-1) THEN
         IF(.NOT.BATCH) THEN
               CALL VDSTCO(1,COLMAP(INDEX),TABLE(1,INDEX),0)
            ELSE
               INDICES(CSPOT) = COLMAP(INDEX)
               RGB(1,CSPOT) = TABLE(1,INDEX)
               RGB(2,CSPOT) = TABLE(2,INDEX)
               RGB(3,CSPOT) = TABLE(3,INDEX)
               CSPOT = MIN0(CSPOT+1,256)
            ENDIF
         ENDIF
      GOTO 3

C          91 -- SELECT COLOR

 1800 CALL PPBTR(16,INDEX,NOEOF)
      IF(COLMAP(INDEX).GE.0) CALL VDSTFC(COLMAP(INDEX))
      NEXTFC = INDEX
      GOTO 3

C          92 -- INTENSITY

 1900 CALL PPBTR(16,INTEN,NOEOF)
      CALL VDSTIN(INTEN/32767.)
      GOTO 3

C          93 -- SET BACKGROUND COLOR

 2000 CALL PPBTR(16,INDEX,NOEOF)
      NEXTBC = INDEX
      IF(NEXTBC.NE.INT(VECTOR(2))) DRAWN = .TRUE.
      GOTO 3

C          A0 -- SET 2D MODE / CLEAR 3D MODE

 3300 TWODIM = .TRUE.
      GOTO 3

C          A1 -- SET 3D MODE / CLEAR 2D MODE

 3400 TWODIM = .FALSE.
      GOTO 3

C          A2 -- SET DRAW MODE / CLEAR MARK MODE

 3500 MARKER = .FALSE.
      GOTO 3

C          A3 -- SET MARK MODE / CLEAR DRAW MODE

 3600 MARKER = .TRUE.
      GOTO 3

C          A4 -- PLOT MARKER AT CURRENT POSITION

 3700 CALL VDIQCP(XPOS,YPOS)
      CALL VDPNTA(XPOS,YPOS)
      GOTO 3

C          A8 -- SET LINE STYLE

 4100 CALL PPBTR(16,LSTYL,NOEOF)
      IF(LSTYL.EQ.32767) THEN
          CALL VDSTLS(0)
      ELSE IF(LSTYL.EQ.0) THEN
          CALL VDSTLS(1)
      ELSE IF(LSTYL.EQ.16382) THEN
          CALL VDSTLS(2)
      ELSE IF(LSTYL.EQ.5461) THEN
          CALL VDSTLS(3)
      ELSE IF(LSTYL.EQ.27305) THEN
          CALL VDSTLS(4)
      ELSE IF(LSTYL.EQ.16383) THEN
          CALL VDSTLS(5)
      ENDIF
      GOTO 3

C          A9 -- SET LINE WIDTH

 4200 CALL PPBTR(16,LWID,NOEOF)
      CALL VDSTLW(LWID/32767.)
      GOTO 3

C (PLC)

C          AA -- POLYGONS

 4400 NPTS =0
 4401 CALL PPBTR(16,OPCODE,NOEOF)
      IF(OPCODE.GE.32768)GOTO 4410
        NPTS = NPTS + 1
        XARRAY(NPTS) = DBLE(OPCODE) * SCALE
        CALL PPBTR(16,OPCODE,NOEOF)
         IF(OPCODE.GE.32768)GOTO 4410
         YARRAY(NPTS) = DBLE(OPCODE) * SCALE
         GOTO 4401

C          IF IT'S AN OPCODE BUT ISN'T = AB (END OF POLYGON COMMAND),
C          THEN IT MUST BE AN OUT OF RANGE COORDINATE.

 4410 IF(OPCODE.NE.43776) THEN
         PRINT 10030, OPCODE
10030    FORMAT(1X,'ILLEGAL X,Y COORDINATE -- ',I5)
         GOTO 8
         ENDIF

C          MAKE SURE THE COLOR WE WANT HAS BEEN SET UP

      IF(COLMAP(NEXTFC).EQ.-1) THEN
         INVMAP(NXTDEX) = NEXTFC
         COLMAP(NEXTFC) = NXTDEX
         CALL VDSTFC(NXTDEX)
         CALL VDSTCO(1,NXTDEX,TABLE(1,NEXTFC),0)
 4411    NXTDEX = NXTDEX + 1
         IF(INVMAP(NXTDEX).NE.-1) GOTO 4411
         ENDIF

      CALL VDPOLY(XARRAY,YARRAY,NPTS)
      GOTO 3

C          B0 -- TEXT STRING

 4900 NCHARS = MIN0(132,COUNT*2)
      IF(NCHARS.EQ.0) GOTO 3
      DO 4910 I=1,NCHARS
         CALL PPBTR(8,TEXT(I),NOEOF)
 4910 CONTINUE

C          MAKE SURE THE COLOR WE WANT HAS BEEN SET UP

      IF(COLMAP(NEXTFC).EQ.-1) THEN
         INVMAP(NXTDEX) = NEXTFC
         COLMAP(NEXTFC) = NXTDEX
         CALL VDSTFC(NXTDEX)
         CALL VDSTCO(1,NXTDEX,TABLE(1,NEXTFC),0)
 4920    NXTDEX = NXTDEX + 1
         IF(INVMAP(NXTDEX).NE.-1) GOTO 4920
         ENDIF

      IF(TEXT(NCHARS).EQ.0) NCHARS = NCHARS - 1
      DRAWN = .TRUE.
      CALL VDTEXT(NCHARS,TEXT)
      COUNT = COUNT - (NCHARS+1)/2
      GOTO 4900

C          B2 -- SET CHARACTER SIZE

 5100 CALL PPBTR(16,ICHAR,NOEOF)
      CALL VDSTCS(ICHAR/32767./.65)
      CALL PPBTR(16,JUNK,NOEOF)
      GOTO 3

C          C0 -- START SEGMENT

 6500 CALL PPBTR(16,NAME,NOEOF)
      CALL PPBTR(16,ITYPE,NOEOF)
      ARGS(1) = NAME
      ARGS(2) = ITYPE
      CALL VDESCP(200,2,ARGS)
      GOTO 3

C          C1 -- END OF SEGMENT

 6600 CALL VDESCP(201,0,0.)
      GOTO 3

C          C2 -- DELETE SEGMENT

 6700 CALL PPBTR(16,NAME,NOEOF)
      ARGS(1) = NAME
      CALL VDESCP(203,1,ARGS)
      GOTO 3

C          C3 -- DELETE ALL SEGMENTS

 6800 CALL VDESCP(203,1,0.)
      GOTO 3

C          C4 -- RENAME SEGMENT

 6900 CALL PPBTR(16,NAME1,NOEOF)
      CALL PPBTR(16,NAME2,NOEOF)
      ARGS(1) = NAME1
      ARGS(2) = NAME2
      CALL VDESCP(202,2,ARGS)
      GOTO 3

C          C5 -- SEGMENT ATTRIBUTES

 7000 CALL PPBTR(16,NAME,NOEOF)
      CALL PPBTR(16,IVALU,NOEOF)
      ARGS(1) = NAME
      ARGS(2) = IVALU
      CALL VDESCP(204,2,ARGS)
      GOTO 3

C          C7 -- BATCH COLOR TABLE UPDATE

 7200 BATCH = .TRUE.
      GOTO 3

C          C8 -- SEND COLOR TABLE / END BATCH UPDATE

 7300 BATCH = .FALSE.
      IF(CSPOT.GT.1) CALL VDSTCO(CSPOT-1,INDICES,RGB,0)
      CSPOT = 1
      GOTO 3

C          ILLEGAL OP CODE

    8 PRINT 10020,OPCODE
10020 FORMAT(1X,'ILLEGAL OP CODE -- ',I5)

C          SCAN FOR NEW FRAME

    9 CALL PPBTR(8,OPCODE,NOEOF)
      CALL PPBTR(8, COUNT,NOEOF)
      IF(OPCODE.NE.255) GOTO 9
      IF( COUNT.NE.255) GOTO 9
      CALL PPBTR(8,OPCODE,NOEOF)
      CALL PPBTR(8, COUNT,NOEOF)
      IF(OPCODE.NE.255) GOTO 9
      IF( COUNT.NE.255) GOTO 9
      CALL PPBTR(8,OPCODE,NOEOF)
      CALL PPBTR(8, COUNT,NOEOF)
      IF(OPCODE.NE.255) GOTO 9
      IF( COUNT.NE.255) GOTO 9
      COUNT = 2
      CALL VDNWPG
      GOTO 1

      END

      SUBROUTINE PPBTR(IWIDTH,RESULT,EOFOK)
C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C

C PPBTR            - FETCH IWIDTH BITS FROM THE INPUT FILE

C P. WATTERBERG    - 25 OCT 81
C K. Cole          - 05 oct 90 added SAVE

C ENVIRONMENT      -COMPUTER-INDEPENDENT, SYSTEM-INDEPENDENT, FORTRAN 77

C ENTRY CONDITIONS - IWIDTH IS THE NUMBER OF BITS TO GET FROM THE FILE.
C                    EOFOK IS TRUE IF AN END OF FILE CAN BE ENCOUNTERED
C                          AND FALSE OTHERWISE.

C CALLS            - CDRUPK, CDRRFS

C EXIT CONDITIONS  - RESULT CONTAINS THE NEXT IWIDTH BITS OF THE FILE, RIGHT
C                    JUSTIFIED, ZERO FILLED.  OR, IF AN END OF FILE IS OK,
C                    AND ENCOUNTERED, RESULT CONTAINS AN HEX 86 TO SIGNIFY
C                    END OF FILE.

C NARRATIVE        -

C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C

      SAVE
      INTEGER IWIDTH, RESULT
      LOGICAL EOFOK

c TLC - made buffer one bigger so cdrupk doesn't go out of memory
      INTEGER BUFFER(10001), POINTR, BUFSIZ, PPREAD

      DATA POINTR /    10001 /
      DATA BUFSIZ /        0 /
      DATA PPREAD /       55 /

      RESULT = 0
      CALL CDRUPK(BUFFER,POINTR,IBITLC,IWIDTH,RESULT)
      IF(POINTR.GT.BUFSIZ) THEN
c          call cdrpst("vdimet.dat",10)
          CALL CDRRFS(PPREAD,10000,BUFFER,IOSTAT)
          IF(IOSTAT.NE.0) THEN
              BUFSIZ = IABS(IOSTAT)
              POINTR = 1
              IBITLC = 0
              CALL CDRUPK(BUFFER,POINTR,IBITLC,IWIDTH,RESULT)
            ELSE
              IF(EOFOK) THEN
                  RESULT = 134
                ELSE
                  PRINT 10010
10010             FORMAT(1X,'UNEXPECTED END OF FILE, PROGRAM ABORT.')
                  CALL VDFRAM(1)
                  CALL VDTERM
                  STOP
                ENDIF
            ENDIF
        ENDIF
      RETURN
      END
