C
C  THIS FILE CONTAINS THE GRAPHICS DEVICE SPECIFIC CODE.
C
C  THE FOLLOWING ROUTINES TYPICALY NEED TO BE MODIFIED WHEN
C  ADDING A NEW DEVICE DRIVER:
C
C  1. GRCLDE    - CLOSE THE DEVICE
C  2. GRDRLI    - DRAW A LINE BETWEEN TWO POINTS
C  3. GRDRPM    - DRAW A HORIZONTAL POLYMARKER
C  4. GRDRPL    - DRAW A POLYLINE
C  5. GRERSC    - ERASE THE SCREEN
C  6. GREXIT    - SHUT DOWN A DEVICE BEFORE EXITING DATAPLOT
C  7. GRFIRE    - FILL A POLYGONAL REGION
C  8. GRINDE    - INITIALIZE THE GRAPHICS DEVICE.
C  9. GRMOBE    - PERFORM A MOVE
C 10. GROPDE    - OPEN THE GRAPHICS DEVICE
C 11. GRRESC    - READ THE SCREEN COORDINATES
C 12. GRSAGR    - IMPLEMENT SAVE PLOT, REPEAT PLOT, CYCLE PLOT
C 13. GRSECO    - SET THE COLOR
C 14. GRSEPA    - SET THE PATTERN (I.E., LINE TYPE, FILL TYPE, ETC.)
C 15. GRSEPP    - SET THE PICTURE POINTS FOR THE DEVICE
C 16. GRSESI    - SET THE TEXT SIZE
C 17. GRSETH    - SET THE LINE THICKNESS
C 18. GRTRCO    - TRANSLATE THE COLOR
C 19. GRTRPA    - TRANSLATE THE LINE OR FILL PATTERN
C 20. GRTRSI    - TRANSLATE THE TEXT SIZE
C 21. GRTTHI    - TRANSLATE THE LINE THICKNESS
C 22. GRWRTH    - WRITE A HORIZONTAL TEXT STRING
C 23. GRWRTV    - WRITE A VERTICAL TEXT STRING
C
C  THE FOLLOWING CODES TYPICALLY DO NOT REQUIRE UPDATING FOR
C  A NEW GRAPHICS DEVICE (ALTHOUGH YOU MAY WANT TO ADD A
C  PLACEHOLDER).
C
C  1. GRCOSC   - COPY THE SCREEN (BASICALLY OBSOLETE, PREVIOUSLY
C                SUPPORTED OLD TEKTRONIX HARD COPY UNITS)
C  2. GRDETH   - DETERMINE LENGTH OF HORIZONTAL TEXT STRING
C  3. GRDETV   - DETERMINE LENGTH OF VERTICAL TEXT STRING
C  4. GRRIBE   - RING THE BELL
C  5. GRSECA   - SET THE TEXT CASE (LOWER/UPPER)
C  6. GRSEDI   - SET THE TEXT DIRECTION
C  7. GRSEFI   - SET THE FILL SPECIFICATION
C  8. GRSEFO   - SET THE TEXT FONT
C  9. GRSEJU   - SET THE TEXT JUSTIFICATION
C 10. GRSEMO   - SET THE DEVICE MODE (GRAPHICS/DIALOGUE)
C 11. GRTRCA   - TRANSLATE THE TEXT CASE (LOWER/UPPER)
C 12. GRTRDI   - TRANSLATE THE TEXT DIRECTION
C 13. GRTRFI   - TRANSLATE THE FILL SPECIFICATION
C 14. GRTRFO   - TRANSLATE THE TEXT FONT
C 15. GRTRJU   - TRANSLATE THE TEXT JUSTIFICATION
C  
C
C  NOTE THAT SOME DRIVERS ARE NOT AVAILBLE ON ALL PLATFORMS.  THERE
C  ARE TWO WAYS THAT WE ADDRESS THIS.
C
C   1. WE PROVIDE AN INTERMEDIATE LIBRARY.  ON UNSUPPORTED SYSTEMS,
C      A DUMMY VERSION OF THIS LIBRARY IS COMPILED.
C
C      THIS APPROACH IS CURRENTLY USED FOR
C
C      a. X11 (x11_src.c is active, x11_src.f is a dummy version)
C      b. GD (for PNG and JPEG) (gd_src.c is active, gd_src.f is a
C                                dummy version)
C      c. AQUA (for Mac OSX) (aqua_src.c is active, aqua_src.f is a
C                                dummy version)
C
C   2. LINES THAT WOULD CAUSE A COMPILATION ERROR ARE COMMENTED
C      OUT USING A SPECIAL PREFIX.  FOR A SUPPORTED SYSTEM, A QUICK
C      GLOBAL CHANGE CAN BE IMPLEMENTED TO ACTIVATE THE CODE.
C
C      THIS APPROACH IS USED IN THE FOLLOWING CASES
C
C      FOR THE COMPAQ 6.x WINDOWS COMPILER, DO THE FOLLOWING:
C
C      1. COPY DP38.FOR TO DP38_QWIN.FOR
C      2. MAKE THE FOLLOWING EDITS IN DP38_QWIN.FOR:
C         A. GLOBAL CHANGE OF "CQWIN" TO "     "
C         B. GLOBAL CHANGE OF "CQWVF" TO "     "
C
C      FOR THE INTEL 8.x WINDOWS COMPILER (THE SUCCESSOR TO THE
C      COMPAQ VISUAL FORTRAN), DO THE FOLLOWING:
C
C      1. COPY DP38.FOR TO DP38_INTEL.FOR
C      2. MAKE THE FOLLOWING EDITS IN DP38_INTEL.FOR:
C         A. GLOBAL CHANGE OF "CIVFO" TO "     "
C         B. GLOBAL CHANGE OF "CQWVF" TO "     "
C
      SUBROUTINE GRCLDE
C
C     PURPOSE--CLOSE A SPECIFIC GRAPHICS DEVICE
C              THAT IS, TURN OFF A DEVICE WHICH IS
C              CURRENTLY ON.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
C
      CHARACTER*130 ICSTR
      CHARACTER*130 IATEMP
      CHARACTER*4 ISUBN0
CCCCC CHARACTER*1 IQUOTE
CCCCC CHARACTER*1 ICARAT
      CHARACTER*1 IA
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
      CHARACTER*4 IERRF1
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOF2.INC'
CCCCC INCLUDE 'DPCOFO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XCLEAR
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='CLDE'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRCLDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
   56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IPPDE1,IPPDE2
   61 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)NCPOST
   62 FORMAT('NCPOST = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOST.LE.0)GOTO65
      DO63I=1,NCPOST
      WRITE(ICOUT,64)I,ICPOST(I:I)
   64 FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
   65 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO8900
C
 1005 CONTINUE
CCCCC IF(IMODEL.EQ.'4662')GOTO1100
CCCCC GOTO8900
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8910
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4662 CASE (A PENPLOTTER)--  **
C               **  TO TURN IT OFF,                                 **
C               **  WRITE OUT AN ESCAPE A F  .                      **
C               ******************************************************
C
 1100 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO1110
      GOTO1119
 1110 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC
C1111 FORMAT(A1,'AF')
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='AF'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1119 CONTINUE
C
      IF(IPPDE1.EQ.'TEKT')GOTO1171
      GOTO1179
 1171 CONTINUE
      IF(NCPOST.GE.1)GOTO1172
      GOTO1179
 1172 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1179 CONTINUE
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO TURN IT OFF,                                 **
C               **  SEND ESCAPE PERIOD RIGHT-PARENTHESIS            **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 72.                             **
C               ******************************************************
C
 2100 CONTINUE
CCCCC WRITE(IGUNIT,2111)IESCC
C2111 FORMAT(A1,'.)','}')
CCCCC WRITE(IGUNIT,2111)IESCC,IESCC
C2111 FORMAT(1H+,A1,'.)',A1,'.Z',':')
      ICSTR(1:1)='+'
      ICSTR(2:2)=IESCC
      ICSTR(3:4)='.)'
      ICSTR(5:5)=IESCC
      ICSTR(6:8)='.Z:'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'7221')GOTO2171
      GOTO2179
 2171 CONTINUE
      IF(NCPOST.GE.1)GOTO2172
      GOTO2179
 2172 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2179 CONTINUE
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO    TURN OFF   INSTRUCTION PER SE,   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
C
C     THE FOLLOWING WAS A SUGGESTED AUGMENTATION
C     (NBS'S YONG-KI KIM, MARCH, 1985)
C     WHEN THE PLOTTER IS CONNECTED IN SERIES
C     BETWEEN THE HOST AND THE TERMINAL,
C     AND THE PLOTTER NEEDS TO BE PUT IN A
C     LISTEN-AND-CAPTURE MODE
C     WHEN GENERATING A PLOT.
C     TO SPECIFY THIS, THE ANALYST
C     ENTERS THE COMMAND        HP-GL +
C     RATHER THAN THE USUAL     HP-GL
C
CCCCC IF(IMODE2.EQ.'+')GOTO2210
CCCCC GOTO2219
C2210 CONTINUE
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='.Z'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C2219 CONTINUE
C
      IF(IPPDE1.EQ.'HPGL')GOTO2271
      IF(IPPDE1.EQ.'HP-G')GOTO2271
      IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL')GOTO2271
      IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL+')GOTO2271
      GOTO2279
 2271 CONTINUE
      IF(NCPOST.GE.1)GOTO2272
      GOTO2279
 2272 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2279 CONTINUE
C
      GOTO8900
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2622')GOTO2371
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2623')GOTO2371
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2627')GOTO2371
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2647')GOTO2371
      GOTO2379
 2371 CONTINUE
      IF(NCPOST.GE.1)GOTO2372
      GOTO2379
 2372 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2379 CONTINUE
C
      GOTO8900
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  LANDSCAPE ORIENTATION                               **
C               **  TO CLOSE DEVICE                                     **
C               **     STEP 1--                                         **
C               **  REFERENCE--                                         **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **********************************************************
C
 2600 CONTINUE
      IF(IPPDE1.EQ.'PCL')GOTO2671
      GOTO2679
 2671 CONTINUE
      IF(NCPOST.GE.1)GOTO2672
      GOTO2679
 2672 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2679 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('CLOSE DEVICE')
      ICSTR(1:12)='CLOSE DEVICE'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(IPPDE1.EQ.'GENE')GOTO3171
      GOTO3179
 3171 CONTINUE
      IF(NCPOST.GE.1)GOTO3172
      GOTO3179
 3172 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3179 CONTINUE
C
      GOTO8900
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:4)='CLDE'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(IPPDE1.EQ.'CODE')GOTO3271
      GOTO3279
 3271 CONTINUE
      IF(NCPOST.GE.1)GOTO3272
      GOTO3279
 3272 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3279 CONTINUE
C
      GOTO8900
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3300 CONTINUE
C
      IF(IPPDE1.EQ.'CODE')GOTO3371
      GOTO3379
 3371 CONTINUE
      IF(NCPOST.GE.1)GOTO3372
      GOTO3379
 3372 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3379 CONTINUE
C
      GOTO8900
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO TURN IT OFF--                                **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE CALCOMP DEVICE')
CCCCC ICSTR(1:45)='FIX SUBROUTINE GRCLDE TO CLOSE CALCOMP DEVICE'
CCCCC NCSTR=45
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8900
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  TO TURN IT OFF--                                **
C               **  CALL PLOT WITH IPEN=999                         **
C               **  ONLY CALL IF ILAHCL = 'ON'                      **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
C
C  ILAHCL  = IF ON, RETURN TO VIDEO TEXT MODE.  THIS IS PREFERRED
C            CHOICE FOR BETTER ALPHANUMERIC OUTPUT.  HOWEVER, MAY WANT
C            TO LEAVE IN GRAPHICS MODE TO GENERATE DIAGRAMMATIC GRAPHICS
C  ILAHPA  = IF ON, REQUEST A CARRIAGE RETURN BEFORE CONTINUING.  IF
C            OFF, CONTINUE REGARDLESS.
C  ILAHSW  = ON IF GRAPHICS MODE SET, OFF IF NORMAL VIDEO MODE SET
C
      IF(ILAHPA.EQ.'ON')THEN
        WRITE(IPR,4601)
        READ(IRD,'(1X,A1)')IA
      ENDIF
 4601 FORMAT(1X,'ENTER CARRIAGE RETURN TO CONTINUE')
      IF(ILAHCL.EQ.'ON')THEN
        AX=0.
        AY=0.
        IPEN=999
        IF(ILAHSW.EQ.'ON')CALL PLOT(AX,AY,IPEN)
        ILAHSW='OFF' 
      ENDIF
      GOTO8900
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(IQWNFC.EQ.'TEXT')THEN
CQWVF   IRESLT=FOCUSQQ(IPR)
CQWVF   IRESLT=DISPLAYCURSOR($GCURSORON)
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IFLAG=1
      CALL GLCLDE()
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
CCCCC IHAND1=0
CCCCC CALL WindowSelect(IHAND1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO TURN IT OFF--                                **
C               **  WRITE OUT    70Z                                **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
C               ******************************************************
C
 5100 CONTINUE
CCCCC WRITE(IGUNIT,5111)
C5111 FORMAT('70Z')
CCCCC ICSTR(1:3)='70Z'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8900
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO TURN IT OFF--                                **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE RAMTEK DEVICE')
      ICSTR(1:44)='FIX SUBROUTINE GRCLDE TO CLOSE RAMTEK DEVICE'
      NCSTR=44
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8900
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               **  NOT NECESSARY TO CLOSE DEVICE                   **
C               ******************************************************
C
 6600 CONTINUE
      IF(IPPDE1.EQ.'SUN')GOTO6671
      GOTO6679
 6671 CONTINUE
      IF(NCPOST.GE.1)GOTO6672
      GOTO6679
 6672 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 6679 CONTINUE
      GOTO9000
C
C               *****************************************************
C               **  STEP 71--                                      **
C               **  TREAT THE XXXXXX  XXXXXX CASE                  **
C               **  TO TURN IT OFF--                               **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                    **
C               **  (NOT DONE)                                     **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               *****************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE XXXXXX DEVICE')
      ICSTR(1:44)='FIX SUBROUTINE GRCLDE TO CLOSE XXXXXX DEVICE'
      NCSTR=44
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8900
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO CLOSE DEVICE---                              **
C               **  WRITE OUT AN XX                                 **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 8100 CONTINUE
      IF(IPPDE1.EQ.'REGI')GOTO8171
      GOTO8179
 8171 CONTINUE
      IF(NCPOST.GE.1)GOTO8172
      GOTO8179
 8172 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8179 CONTINUE
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  REFERENCE: POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
C               ******************************************************
C
 8600 CONTINUE
C
      IF(IPPDE1.EQ.'POST')GOTO8671
      GOTO8679
 8671 CONTINUE
      IF(NCPOST.GE.1)GOTO8672
      GOTO8679
 8672 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8679 CONTINUE
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8910 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE - NULL ROUTINE              **
C               ******************************************************
C
 9100 CONTINUE
C
      IF(IPPDE1.EQ.'QUIC')GOTO9171
      GOTO9179
 9171 CONTINUE
      IF(NCPOST.GE.1)GOTO9172
      GOTO9179
 9172 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 9179 CONTINUE
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE - FLUSH THE BUFFER       **
C               **  REFERENCE--DDC SOFTWARE TRANSLATOR MANUAL       **
C               ******************************************************
C
 9600 CONTINUE
C
      IF(IPPDE1.EQ.'X11 ')GOTO9671
      GOTO9679
 9671 CONTINUE
      IF(NCPOST.GE.1)GOTO9672
      GOTO9679
 9672 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 9679 CONTINUE
C
      IF(IX11OF.NE.'OFF')CALL XCLEAR
      GOTO8900
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCCLDE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CGKS  CALL GDAWK(IGKSWK)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
CAQUA CALL aqtRenderPlot()
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
C
CCCCC ICSTR(1:1)=IBASLC
CCCCC ICSTR(2:13)='end{picture}'
CCCCC NCSTR=13
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC IF(IMODEL.NE.'STAN')THEN
C
CCCCC   ICSTR(1:1)=' '
CCCCC   NCSTR=1
CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC   ICSTR(1:1)=IBASLC
CCCCC   ICSTR(2:18)='begin{verbatim}'
CCCCC   NCSTR=18
CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC ELSEIF(ILATFO.EQ.'NULL')THEN
C
CCCCC   ICSTR(1:1)=' '
CCCCC   NCSTR=1
CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC   ICSTR(1:1)=IBASLC
CCCCC   ICSTR(2:16)='end{document}'
CCCCC   NCSTR=16
CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC ELSE
CCCCC   IOUNI1=IST1NU
CCCCC   IFILE1=ILATFO
CCCCC   ISTAT1='OLD'
CCCCC   IFORM1='FORMATTED'
CCCCC   IACCE1='SEQUENTIAL'
CCCCC   IPROT1='READONLY'
CCCCC   ICURS1='CLOSED'
CCCCC   ISUBN0='CAPT'
CCCCC   IERRF1='NO'
C
CCCCC   IREWI1='ON'
CCCCC   CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
CCCCC1                IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
CCCCC   IF(IERRF1.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
CCCCC   DO15301I=1,1000
CCCCC     IATEMP=' '
CCCCC     READ(IOUNI2,15392,END=15399,ERR=15399)IATEMP
15392     FORMAT(A240)
CCCCC     ILAST=1
CCCCC     DO15410J=240,1,-1
CCCCC       IF(IATEMP(J:J).NE.' ')THEN
CCCCC         ILAST=J
CCCCC         GOTO15419
CCCCC       ENDIF
15410     CONTINUE
15419     CONTINUE
CCCCC     ICSTR(1:ILAST)=IATEMP(1:ILAST)
CCCCC     NCSTR=ILAST
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15301   CONTINUE
15399   CONTINUE
CCCCC   IENDF1='OFF'
CCCCC   IREWI1='ON'
CCCCC   CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
CCCCC1                IENDF1,IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
CCCCC   IF(IERRF1.EQ.'YES')GOTO9000
CCCCC ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 89--                             **
C               **  IF CALLED FOR, WRITE OUT              **
C               **  A USER-DEFINED POST-PLOT LINE         **
C               ********************************************
C
 8900 CONTINUE
      IF(IPPDE1.EQ.'ANY')GOTO8971
      IF(IPPDE1.EQ.'ALL')GOTO8971
      GOTO8979
 8971 CONTINUE
      IF(NCPOST.GE.1)GOTO8972
      GOTO8979
 8972 CONTINUE
      NCSTR=NCPOST
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8979 CONTINUE
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRCLDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IPPDE1,IPPDE2
 9031 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)NCPOST
 9032 FORMAT('NCPOST = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOST.LE.0)GOTO9035
      DO9033I=1,NCPOST
      WRITE(ICOUT,9034)I,ICPOST(I:I)
 9034 FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9033 CONTINUE
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRCOSC
C
C     PURPOSE--COPY THE SCREEN
C              OF A SPECIFIC GRAPHICS DEVICE.
C     NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. PORTABLE BITMAP (PBM) (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*4 ICARAT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='COSC'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      ICHAPS=0
      INULLI=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'COSC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRCOSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGBAUD,AGCODE
   53 FORMAT('IGBAUD,AGCODE = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGG4
   55 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO9000
C
      IF(IMODEL.EQ.'4020')GOTO1200
      IF(IMODEL.EQ.'4022')GOTO1200
      IF(IMODEL.EQ.'4025')GOTO1200
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ************************************************************
C               **  STEP 11--                                             **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
C               **  TO COPY  THE SCREEN,                                  **
C               **  WRITE OUT AN ESCAPE ETB                               **
C               ************************************************************
C
 1100 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC,IETBC
C1111 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IETBC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      DO1130J=1,10
      ICSTR(J:J)=INULC
 1130 CONTINUE
      NCSTR=10
C
CCCCC ICHAPS=IGBAUD/10
CCCCC INULLI=ICHAPS/10
      INULLI=AGCODE+0.5
      IF(INULLI.LE.0)GOTO1139
      DO1135I=1,INULLI
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1135 CONTINUE
 1139 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
C               **  (NON-COLOR RASTER DEVICES).                     **
C               **  TO COPY  THE SCREEN,                            **
C               **  XXX                                             **
C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-5.    **
C               ******************************************************
C
 1200 CONTINUE
CCCCC WRITE(IGUNIT,1411)
C1411 FORMAT('!MON H')
CCCCC WRITE(IGUNIT,1412)
C1412 FORMAT('!HCO W')
CCCCC WRITE(IGUNIT,1413)
C1413 FORMAT('!WOR H')
CCCCC WRITE(IGUNIT,1211)
C1211 FORMAT('!COP W/N P;')
      ICSTR(1:11)='!COP W/N P;'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE 4105 CASE                             **
C               **  (COLOR DEVICE)                                  **
C               **  REFERENCE--PAGE 5-53                            **
C               ******************************************************
C
 1300 CONTINUE
CCCCC WRITE(IGUNIT,1311)IESCC,IETBC
C1311 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IETBC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      DO1330J=1,10
      ICSTR(J:J)=INULC
 1330 CONTINUE
      NCSTR=10
C
CCCCC ICHAPS=IGBAUD/10
CCCCC INULLI=ICHAPS/10
      INULLI=AGCODE+0.5
      IF(INULLI.LE.0)GOTO1339
      DO1335I=1,INULLI
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1335 CONTINUE
 1339 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
CCCCC WRITE(IGUNIT,2111)
C2111 FORMAT('~+}')
      ICSTR(1:3)='~+}'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO    COPY SCREEN   INSTRUCTION PER SE.**
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-17, 5-5???.                          **
C               **********************************************************
C
 2300 CONTINUE
      IF(IMODEL.EQ.'2647')GOTO2320
      GOTO2310
 2310 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:9)='&p7s4dmZ'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO2390
 2320 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:9)=',cTR A G'
      ICSTR(10:10)=ICRC
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO2390
 2390 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  TO MAKE MULTIPLE COPIES, ESCC &laaX                 **
C               **  WHERE aa IS AN INTEGER NUMBER OF COPIES (UP TO 99)  **
C               **  PROBLEM: THIS COMMAND DOES NOT DO AN IMMEDIATE COPY,**
C               **  IT SETS THE NUMBER OF COPIES TO BE DONE WHEN A PRINT**
C               **  PAGE COMMAND IS ISSUED.  MAY HAVE TO CHANGE LOGIC   **
C               **  OF WHEN THIS COMMAND IS DONE.                       **
C               **  REFERENCE-- LASER JET SERIES II TECHNICAL           **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 4-2                                 **
C               **********************************************************
C
 2600 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='&l1X'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('COPY SCREEN')
      ICSTR(1:11)='COPY SCREEN'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:4)='COSC'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
C               ***************************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO COPY SCREEN--                                **
C               **  NO COPY SCREEN FUNCTION                         **
C               **  REFERENCE--CALCOMP LIBRARY MANUAL               **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY CALCOMP DEVICE')
CCCCC ICSTR(1:44)='FIX SUBROUTINE GRCOSC TO COPY CALCOMP DEVICE'
CCCCC NCSTR=44
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  NO COPY SCREEN COMMAND SUPPORTED AT THIS TIME   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  THERE IS NO    COPY SCREEN   INSTRUCTION PER SE.**
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO COPY SCREEN--                                **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY RAMTEK DEVICE')
      ICSTR(1:43)='FIX SUBROUTINE GRCOSC TO COPY RAMTEK DEVICE'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - NULL ROUTINE               **
C               ******************************************************
C
 6600 CONTINUE
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO COPY SCREEN--                                **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY XXXXXX DEVICE')
      ICSTR(1:43)='FIX SUBROUTINE GRCOSC TO COPY XXXXXX DEVICE'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO COPY (GRAPHICS) SCREEN---                    **
C               **  WRITE OUT AN S ( H )                            **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 146                            **
C               ******************************************************
C
 8100 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='Pp'
      ICSTR(4:7)='S(H)'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  NO COPY COMMAND - NULL ROUTINE                  **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  1) ^DCnnnn  - PRINTS nnnn COPIES OF CURRENT PAGE**
C               **  2) ^DCCnnnn - PRINTS nnnn COPIES OF ALL         **
C               **     SUBSEQUENT PAGES                             **
C               **  REFERENCE: QMS PROGRAMMING MANUAL               **
C               **  PAGE: 12-6                                      **
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:8)='DC00001'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11 CASE - NULL ROUTINE               **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCCOSC
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'COSC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRCOSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGBAUD,AGCODE
 9013 FORMAT('IGBAUD,AGCODE = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICHAPS,INULLI
 9014 FORMAT('ICHAPS,INULLI = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IESCC,IETBC,ISYNC
 9015 FORMAT('IESCC,IETBC,ISYNC = ',A1,2X,A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IMANUF,IMODEL
 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRDETH(ICTEXT,NCTEXT,
     1IFONT,IDIR,ANGLE,
     1JFONT,JDIR,ANGLE2,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1PXLEC,PXLECG,PYLEC,PYLECG)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              FOR THE STANDARD (SPECIFIC) FONT,
C              AND FOR THE HORIZONTAL DIRECTION,
C              DETERMINE THE LENGTH OF THE TEXT STRING IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF NTEXT CHARACTERS.
C     NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES
C           THAT IS, 0.0 TO 100.0
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONCTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICTEXT
      CHARACTER*4 IFONT
      CHARACTER*4 IDIR
C
      DIMENSION ICTEXT(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRDETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCTEXT
   54 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT)
   55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IFONT,JFONT
   61 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IDIR,JDIR
   62 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)JSIZE
   71 FORMAT('JSIZE= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C                *****************************************************
C                **  APRIL, 1988.  GENERIC CASE FOR FIXED SPACE FONT**
C                *****************************************************
C
      ANCTEX=NCTEXT
      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
      PYLEC=PHEIG2
      PYLECG=PHEIG2+PVEGA2
C
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO1100
C
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4662                        **
C               **  (A PENPLOTTER).                                 **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 12--                                               **
C               **  TREAT THE TEKTRONIX 4027 CASE                           **
C               **  (COLOR RASTER DEVICES).                                 **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE TEKTRONIX 4105                        **
C               **  (COLOR RASTER DEVICE).                          **
C               **  REFERENCE--PAGE XXXX (LINE), XXXX (TEXT),       **
C               **             XXXX (REGION)                        **
C               ******************************************************
C
 1300 CONTINUE
      GOTO9000
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 73.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-10, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM CASE                              **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM (BINARY) CASE                     **
C               ******************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE                             **
C               **  SUPPORT THE PROPORTIONAL FONTS THAT ARE         **
C               **  "HARD-CODED" IN THE QMS.                        **
C               **                                                  **
C               ******************************************************
C
 9100 CONTINUE
      ANUMPP=ANUMHP
      IFONTT=IQUIFN
      IF(IORNSW.EQ.'PORT'.AND.(
     1IFONTT.EQ.521.OR.
     1IFONTT.EQ.522.OR.
     1IFONTT.EQ.523.OR.
     1IFONTT.EQ.524))IFONTT=10
      IF(IORNSW.NE.'PORT'.AND.(
     1IFONTT.EQ.124.OR.
     1IFONTT.EQ.144.OR.
     1IFONTT.EQ.16.OR.
     1IFONTT.EQ.328.OR.
     1IFONTT.EQ.998.OR.
     1IFONTT.EQ.404.OR.
     1IFONTT.EQ.444.OR.
     1IFONTT.EQ.532))IFONTT=10
      IF(IFONTT.EQ.10)GOTO9000
      IF(IFONTT.EQ.404)GOTO9000
      IF(IFONTT.EQ.444)GOTO9000
      IF(IFONTT.EQ.521)GOTO9000
      IF(IFONTT.EQ.522)GOTO9000
      IF(IFONTT.EQ.523)GOTO9000
      IF(IFONTT.EQ.524)GOTO9000
      IF(IFONTT.EQ.532)GOTO9000
      IF(IFONTT.EQ.517)GOTO9000
      IF(IFONTT.EQ.536)GOTO9000
      IF(IFONTT.EQ.904)GOTO9000
      IF(IFONTT.EQ.924)GOTO9000
      IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE                          **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRDETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCTEXT
 9014 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(ICTEXT(I),I=1,NCTEXT)
 9015 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IFONT,JFONT
 9021 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IDIR,JDIR
 9022 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)JSIZE
 9031 FORMAT('JSIZE= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRDETV(ICTEXT,NCTEXT,
     1IFONT,IDIR,ANGLE,
     1JFONT,JDIR,ANGLE2,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1PXLEC,PXLECG,PYLEC,PYLECG)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              FOR THE STANDARD (TEKTRONIX) FONT,
C              AND FOR THE VERTICAL DIRECTION,
C              DETERMINE THE LENGTH OF THE TEXT STRING IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF NTEXT CHARACTERS.
C     NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES
C           THAT IS, 0.0 TO 100.0
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONCTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICTEXT
      CHARACTER*4 IFONT
      CHARACTER*4 IDIR
C
      DIMENSION ICTEXT(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETV')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRDETV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCTEXT
   54 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT)
   55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IFONT,JFONT
   61 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IDIR,JDIR
   62 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)JSIZE
   71 FORMAT('JSIZE= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C                *****************************************************
C                **  APRIL, 1988.  GENERIC CASE FOR FIXED SPACE FONT**
C                *****************************************************
C
      ANCTEX=NCTEXT
      PXLEC=PWIDT2
      PXLECG=PWIDT2+PHOGA2
      PYLEC=(ANCTEX-1.0)*(PHEIG2+PVEGA2)+PHEIG2
      PYLECG=ANCTEX*(PHEIG2+PVEGA2)
C
C
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO1100
C
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4662                        **
C               **  (A PENPLOTTER).                                 **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 12--                                               **
C               **  TREAT THE TEKTRONIX 4027 CASE                           **
C               **  (COLOR RASTER DEVICES).                                 **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE TEKTRONIX 4105                        **
C               **  (COLOR RASTER DEVICE).                          **
C               **  REFERENCE--PAGE XXXX (LINE), XXXX (TEXT),       **
C               **             XXXX (REGION)                        **
C               ******************************************************
C
 1300 CONTINUE
      GOTO9000
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 73.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-10, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM CASE                              **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  VERTICAL TEXT STRINGS WILL BE ROTATED           **
C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINES         **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      ANCTEX=NCTEXT
      PYLEC=PHEIG2
      PYLECG=PHEIG2+PVEGA2
      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      ANCTEX=NCTEXT
      PYLEC=PHEIG2
      PYLECG=PHEIG2+PVEGA2
      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      ANCTEX=NCTEXT
      PYLEC=PHEIG2
      PYLECG=PHEIG2+PVEGA2
      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE                             **
C               **  SUPPORT THE PROPORTIONAL FONTS THAT ARE         **
C               **  "HARD-CODED" IN THE QMS.                        **
C               **                                                  **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE                          **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETV')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRDETV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCTEXT
 9014 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(ICTEXT(I),I=1,NCTEXT)
 9015 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IFONT,JFONT
 9021 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IDIR,JDIR
 9022 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)JSIZE
 9031 FORMAT('JSIZE= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRDRLI(IX1,IY1,IX2,IY2,PX1,PY1,PX2,PY2,IFACTO,JCOL)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              DRAW A LINE FROM (IX1,IY1) TO (IX2,IY2).
C     NOTE--THE COORDINATES (IX1,IY1) AND (IX2,IY2) ARE IN
C           INTEGER PICTURE POINT VALUES.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. BAD ARG IN 2 CALLS TO GRTRIN
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --MAY      1991. X2 TO IX2 FOR SUN  (JJF)
C     UPDATED         --APRIL    1992. ZETA FIX
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. UPDATE TO GENERAL CODED FOR
C                                      GUI.
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --JUNE     2000. PC PRINTER
C     UPDATED         --JULY     2001. ADD JCOL ARGUMENT (COLOR INDEX
C                                      FOR GD DEVICE)
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC ADD FOLLOWING LINES FOR OPEN-GL
CINTE USE INTERACTER
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
      CHARACTER*4 QWSCRN
      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
CQWVF TYPE (XYCOORD)   WXY
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*1 ICARAT
      CHARACTER*1 IQUOTE
      CHARACTER*2 ICJUNK
      CHARACTER*4 ICOL
      INTEGER IXSUN(2)
      INTEGER IYSUN(2)
      REAL PXGKS(2)
      REAL PYGKS(2)
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XDRAW
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='DRLI'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRLI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRDRLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IX1,IY1,IX2,IY2
   52 FORMAT('IX1,IY1,  IX2,IY2 = ',2I8,4X,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PX1,PY1
   54 FORMAT('PX1,PY1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PX2,PY2
   55 FORMAT('PX2,PY2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFACTO
   57 FORMAT('IFACTO = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)IGUNIT
   58 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IMANUF,IMODEL
   68 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************
C               **  STEP XX--                         **
C               **  CHECK THAT THE INPUT COORDINATES  **
C               **  ARE WITHIN SCREEN LIMITS          **
C               ****************************************
C
      IX3=IX1
      IF(IX3.LE.0)IX3=0
      IF(IX3.GE.NUMHPP)IX3=NUMHPP-1
C
      IY3=IY1
      IF(IY3.LE.0)IY3=0
      IF(IY3.GE.NUMVPP)IY3=NUMVPP-1
C
      IX4=IX2
      IF(IX4.LE.0)IX4=0
      IF(IX4.GE.NUMHPP)IX4=NUMHPP-1
C
      IY4=IY2
      IF(IY4.LE.0)IY4=0
      IF(IY4.GE.NUMVPP)IY4=NUMVPP-1
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4027')GOTO1200
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************
C               **  STEP 11--               **
C               **  TREAT THE TEKTRONIX 40104 (ETC.) CASE  **
C               ******************************
C
 1100 CONTINUE
      ICSTR(1:1)=IGSC
      NCSTR=1
      CALL TKTRPT(IX3,IY3,IFACTO,ICSTR,NCSTR,ISUBN0)
      CALL TKTRPT(IX4,IY4,IFACTO,ICSTR,NCSTR,ISUBN0)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               *******************************
C               **  STEP 12--                **
C               **  TREAT THE 4027 CASE      **
C               **  (A COLOR RASTER DEVICE)  **
C               **  REFERENCE--XX            **
C               *******************************
C
 1200 CONTINUE
CCCCC WRITE(IGUNIT,1211)IX3,IY3,IX4,IY4
C1211 FORMAT('!VEC ',4I8)
      ICSTR(1:5)='!VEC '
      NCSTR=5
      NCHTOT=8
      CALL GRTRIN(IX3,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY3,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX4,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY4,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2100 CONTINUE
      ICSTR(1:1)='p'
      NCSTR=1
      CALL HPTRPT(IX1,IY1,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)='q'
      NCSTR=1
      CALL HPTRPT(IX2,IY2,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:5)='PD;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pa'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(16:16)='Z'
      NCSTR=16
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pb'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      ICSTR(16:16)='Z'
      NCSTR=16
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE HEWLETT-PACKARD PCL LANDSCAPE CASE    **
C               **  (HP LASER PRINTERS, E.G. LASER JET              **
C               **  USE HPBRES TO DRAW THE LINE WITH THE            **
C               **  BRESENHAM ALGORITHM.                            **
C               ******************************************************
C
 2600 CONTINUE
      JTHICK=3
      ICOL='NULL'
      CALL HPBRES(IX1,IY1,IX2,IY2,ICOL,JTHICK)
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)PX1,PY1
C3111 FORMAT('MOVE TO ',F10.5,2X,F10.5)
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,3121)PX2,PY2
C3121 FORMAT('DRAW TO ',F10.5,2X,F10.5)
      ICSTR(1:8)='DRAW TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
C  MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIV POINTS IF THEY
C  ARE IDENTICAL.
C
 3200 CONTINUE
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='DRTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3290
C
 3250 CONTINUE
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      IPX1=INT(PX1*10.**IGENFA+0.5)
      IPY1=INT(PY1*10.**IGENFA+0.5)
      CALL GRTRIN(IPX1,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='  '
      CALL GRTRIN(IPY1,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:2)='D '
      NCSTR=2
      NCHTOT=IGENFA+3
      IPX2=INT(PX2*10.**IGENFA+0.5)
      IPY2=INT(PY2*10.**IGENFA+0.5)
      CALL GRTRIN(IPX2,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='  '
      CALL GRTRIN(IPY2,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3290 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3300 CONTINUE
      ICSTR(1:6)='LINE '
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:29)=', '
      NCSTR=29
      CALL GRTRSA(PX2,PY2,AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(40:40)=','
      NCSTR=40
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(50:50)=';'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINES         **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE CALCOMP DEVICE')
CCCCC ICSTR(1:49)='FIX SUBROUTINE GRDRLI TO DRAW LINE CALCOMP DEVICE'
CCCCC NCSTR=49
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
      IPEN=3
      CALL PLOT(AX1,AY1,IPEN)
      IPEN=2
      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
      CALL PLOT(AX1,AY1,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
      IPEN=3
      CALL PLOT(AX1,AY1,IPEN)
      IPEN=2
      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
      CALL PLOT(AX1,AY1,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
CCCCC PYTEMP=100.-PY1
      PYTEMP=PY1
      CALL GRTRSD(PX1,PYTEMP,IX1,IY1,ISUBN0)
CQWVF CALL MOVETO(INT2(IX1),INT2(IY1),WXY)
CCCCC PYTEMP=100.-PY1
      PYTEMP=PY2
      CALL GRTRSD(PX2,PYTEMP,IX2,IY2,ISUBN0)
CQWVF ISTATUS=LINETO(INT2(IX2),INT2(IY2))
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      PXGKS(1)=PX1
      PYGKS(1)=100.0 - PY1
      PXGKS(2)=PX2
      PYGKS(2)=100.0 - PY2
      NPTS=2
      CALL GLDRAW(PXGKS,PYGKS,NPTS)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
CINTE CALL IGrMoveTo(REAL(IX1),REAL(IY1))
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
CINTE CALL IGrLineTo(REAL(IX2),REAL(IY2))
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
CWINT CALL IGrMoveTo(PX1,PY1)
CWINT CALL IGrLineTo(PX2,PY2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY ROUTINES                    **
C               ******************************************************
C
 5100 CONTINUE
      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
      IPEN=3
      CALL PLOT(AX1,AY1,IPEN)
      IPEN=2
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992   ALAN
CCCCC IF(JPATT.GT.0)IPEN=13+JPATT
CCCCC IF(IPEN.NE.2 .AND. (IPEN.LT.14.OR.IPEN.GT.19))IPEN=2
      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
      CALL PLOT(AX1,AY1,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO DRAW LINE--                                  **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRDRLI TO DRAW LINE RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
C
 6600 CONTINUE
      IXSUN(1) = IX1
      IXSUN(2) = IX2
      IYSUN(1) = IY1
      IYSUN(2) = IY2
CSUN  CALL cfpolyline(IXSUN,IYSUN,2)
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO DRAW LINE--                                  **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRDRLI TO DRAW LINE XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO XXX---                                       **
C               **  WRITE OUT AN XX                                 **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 96 AND 145                     **
C               ******************************************************
C
 8100 CONTINUE
      ICSTR(1:2)='P['
      NCSTR=2
      NCHTOT=5
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:3)='V[]'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      ICSTR(1:2)='V['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      ICSTR(1:8)='newpath '
      NCSTR=8
      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:27)=' moveto '
      NCSTR=27
      CALL GRTRSD(PX2,PY2,IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(33:33)=' '
      NCSTR=33
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(39:52)=' lineto stroke'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC LANDSCAPE CASE                   **
C               **  <ICARAT>IGV       - ENABLE VECTOR GRAPHICS MODE **
C               **  <ICARAT>WTTTTTBBBBBLLLLLRRRRR - SET PAGE MARGINS**
C               **  NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER*
C               **        OF PICTURE POINTS.  WE ONLY WANT TO CLIP  **
C               **        AT THE MARGIN, NOT FORCE A PAGE ERASE.    **
C               **  <ICARAT>Tttttt    - SET Y ORGIN FROM TOP OF PAGE**
C               **  <ICARAT>Jjjjjj    - SET X ORGIN FROM LEFT       **
C               **  <ICARAT>PWnn      - SET PEN WIDTH (3 CLOSEST TO **
C               **                      0.1 DATAPLOT UNITS)         **
C               **  <ICARAT>UXXXXX:YYYYY - MOVE                     **
C               **  <ICARAT>DXXXXX:YYYYY - DRAW                     **
C               **  <ICARAT>IGE       - DISABLE VECTOR GRAPHICS MODE**
C               **  REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER ON **
C               **             VECTOR GRAPHICS                      **
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:4)='IGV'
      ICSTR(5:5)=ICARAT
      ICSTR(6:6)='W'
C
      IF(IORNSW.EQ.'PORT')GOTO9110
CCCCC AXLEFT=IQUILM
CCCCC AXRGHT=11.*QUIPPI-IQUIRM
CCCCC AYTOP=IQUITM
CCCCC AYBOT=8.5*QUIPPI-IQUIBM
CCCCC AFACTH=11.*QUIPPI
CCCCC AFACTV=8.5*QUIPPI
      IX2=11000
      IY2=8500
      GOTO9120
C
 9110 CONTINUE
C
CCCCC AXLEFT=IQU2LM
CCCCC AXRGHT=8.5*QUIPPI-IQU2RM
CCCCC AYTOP=IQU2TM
CCCCC AYBOT=11.*QUIPPI-IQU2BM
CCCCC AFACTH=8.5*QUIPPI
CCCCC AFACTV=11.*QUIPPI
      IX2=8500
      IY2=11000
C
 9120 CONTINUE
C
CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5)
CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5)
CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5)
CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5)
      IX=0
      IY=0
      NCSTR=6
      NCHTOT=-5
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(27:27)=ICARAT
      ICSTR(28:33)='T00000'
      ICSTR(34:34)=ICARAT
      ICSTR(35:40)='J00000'
      ICSTR(41:41)=ICARAT
      ICSTR(42:45)='PW03'
      NCSTR=45
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:2)='U'
C     NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y
      PYTEMP=100.-PY1
      CALL QUICPT(PX1,PYTEMP,IX1,IY1,ISUBN0)
      NCSTR=2
      NCHTOT=-5
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=':'
      NCSTR=8
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991
CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBNO)
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=ICARAT
      ICSTR(15:15)='D'
      NCSTR=15
      PYTEMP=100.-PY2
      CALL QUICPT(PX2,PYTEMP,IX1,IY1,ISUBN0)
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      ICSTR(21:21)=ICARAT
      NCSTR=21
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991
CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBN0)
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(27:27)=ICARAT
      ICSTR(28:30)='IGE'
      NCSTR=30
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9000
      NTEMP=2
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      IXSUN(1)=IX1
      IYSUN(1)=IY1
CCCCC THE FOLLOWING LINE WAS CORRECTED MAY 24, 1991 (JJF)
CCCCC IXSUN(2)=X2
      IXSUN(2)=IX2
      IYSUN(2)=IY2
      CALL XDRAW(IXSUN,IYSUN,NTEMP)
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      IF(ITCST.EQ.'CLOS')GOTO9000
      CALL TCDRLI(PX1,PY1,PX2,PY2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      NP=2
      PXGKS(1) = PX1
      PXGKS(2) = PX2
      PYGKS(1) = PY1
      PYGKS(2) = PY2
CGKS  CALL GPL(NP, PXGKS, PYGKS)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      NTEMP=2
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      JPATT=1
CCCCC JULY 2001.  PASS JCOL AS ARGUMENT RATHER THAN HARD CODING IT.
CCCCC JCOL=1
      CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      AX1=REAL(IX1)
      AY1=REAL(IY1)
CAQUA CALL aqtMoveTo(AX1,AY1)
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      AX2=REAL(IX2)
      AY2=REAL(IY2)
CAQUA CALL aqtAddLineTo(AX2,AY2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
15000 CONTINUE
      ICSTR(1:1)=IBASLC
      ICSTR(2:13)='drawline[ 0]'
      NCSTR=13
C
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      NCHTOT=5
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='('
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='('
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
C
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL DPCONA(34,IQUOTE)
C
      ICSTR(1:8)='   <line'
      ICSTR(9:9)=IQUOTE
      NCSTR=-9
C
      IF(ISVGSS(1:3).EQ.'EXT')THEN
        NCSTR=12
        ICSTR(1:NCSTR)='      class='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+6)='narrow-'
        NCSTR=NCSTR+7
        ICSTR(NCSTR:NCSTR+4)='solid'
        NCSTR=NCSTR+5
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        CALL GRTRCO('FORE',ISVGFC,JCOL2)
        IF(JCOL2.NE.JCOL)THEN
          ICSTR(1:12)='      style='
          ICSTR(13:13)=IQUOTE
          NCSTR=-13
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:21)='             stroke:#'
          NCSTR=21
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+2
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:13)='             '
          ICSTR(14:14)=IQUOTE
          NCSTR=-14
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
C
      ELSE
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:15)='         style='
        ICSTR(16:16)=IQUOTE
        NCSTR=-16
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:28)='             stroke-width:1;'
        NCSTR=-26
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(ISVGCA.EQ.'ROUN')THEN
          NCSTR=35
          ICSTR(1:NCSTR)='             stroke-linecap: round;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGCA.EQ.'SQUA')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linecap: square;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGCA.EQ.'BUTT')THEN
          NCSTR=34
          ICSTR(1:NCSTR)='             stroke-linecap: butt;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          CONTINUE
        ENDIF
C
        IF(ISVGJS.EQ.'ROUN')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: round;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGJS.EQ.'BEVE')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: bevel;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGJS.EQ.'MITE')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: miter;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          CONTINUE
        ENDIF
C
        ICSTR(1:21)='             stroke:#'
        NCSTR=21
        NCHTOT=2
        JTEMP=JCOL
        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+2
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
C
      NCHTOT=5
      ICSTR(1:9)='      x1='
      ICSTR(10:10)=IQUOTE
      NCSTR=10
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+3)=' y1='
      NCSTR=NCSTR+4
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+3)=' x2='
      NCSTR=NCSTR+4
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+3)=' y2='
      NCSTR=NCSTR+4
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+1)='/>'
      NCSTR=-(NCSTR+1)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRLI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRDRLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IX1,IY1,IX2,IY2
 9012 FORMAT('IX1,IY1,  IX2,IY2 = ',2I8,4X,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IX3,IY3,IX4,IY4
 9013 FORMAT('IX3,IY3,  IX4,IY4 = ',2I8,4X,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMODEL
 9014 FORMAT('IMODEL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PX1,PY1
 9015 FORMAT('PX1,PY1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PX2,PY2
 9016 FORMAT('PX2,PY2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFACTO
 9017 FORMAT('IFACTO = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IGUNIT
 9018 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IMANUF,IMODEL
 9019 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRDRPH(PX,PY,NP,
     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PTHICK,JTHICK,PTHIC2,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ISYMBL,ISPAC)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              DRAW THE HORIZONTAL POLYMARKER WHOSE COORDINATES
C              ARE GIVEN IN (PX(.),PY(.)).
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
C                                       DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
C     UPDATED         --JULY     1990.  PACK HP-2622 OUTPUT
C     UPDATED         --MARCH    1991.  PACK REGIS OUTPUT
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C                                       DRIVER OBSOLETE
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C     UPDATED         --MAY      1991.  FIX POSTSCRIPT CHAR. INDICES
C     UPDATED         --OCTOBER  1991.  POSTSCRIPT FONTS (ALAN)
C     UPDATED         --MAY      1992.  ADJUST JUSTIFICATION
C                                       FOR WINDOW (ALAN)
C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
C                                 BAD C-SIDE CHARACTER PLOTS (NO X'S)
C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
C                                       BAD C-SIDE MULTIPLOTS (SCALING)
C     UPDATED         --JANUARY   1995. FIX CHAR CENTERING FOR TURBO-C
C     UPDATED         --SEPTEMBER 1995. FIX TURBO-C SECTION
C                          BAD C-SIDE CHARACTER PLOTS (NO X'S) (AGAIN)
C     UPDATED         --SEPTEMBER 1995. ADD "PIXEL" CHARACTER TO DRAW
C                                       A SINGLE POINT.  NOT IMPLEMENTED
C                                       FOR ALL DEVICES ON INITIAL PASS.
C     UPDATED         --JULY     1996 . LAHEY DRIVER (ALAN HECKERT)
C                                       OLD CALCOMP STYLE
C                                       DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LOWER CASE "BLAN" (BUG FOR CASE
C                                      ASIS)
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEK DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC FOLLOWING LINE FOR OPEN-GL
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC FOLLOWING LINE FOR MICROSOFT FORTRAN OCTOBER 1996
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
      CHARACTER*4 QWSCRN
      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWFN
CQWVF TYPE (XYCOORD)   WXY
C
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*4 IC4
      CHARACTER*1 IC
      CHARACTER*1 IC1
      CHARACTER*1 IC2
      CHARACTER*1 ICARAT
      CHARACTER*1 IQUOTE
      CHARACTER*2 ICJUNK
C
      DIMENSION PX(*)
      DIMENSION PY(*)
C
      DIMENSION ICTEXT(10)
      DIMENSION IHOLL(10)
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C  FOLLOWING 2 LINES ADDED MARCH, 1990 FOR X11
      INTEGER STRING(10)
      INTEGER IADE(80)
CCCCC FOLLOWING 5 LINES FOR LAHEY COMPILER ADDED JULY 1996.
      CHARACTER*40 CLAHEY
      REAL RLAHEY(7)
      INTEGER ILAHEY(9)
      CHARACTER*4 IJUSTH
      CHARACTER*4 IJUSTV
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
CCCCC THE FOLLOWING COMMON BLOCK WAS ADDED MAY 1992.
      COMMON /RWIND/
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PWZMAX,
     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XTATTR, XTEXTH
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='DRPH'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IC4='-999'
      IC='-'
      IC1='-'
      IC2='-'
C
      PXDEL=(-999.0)
      PYDEL=(-999.0)
C
      PXINC=(-999.0)
      PYINC=(-999.0)
C
      K=(-999)
      NCTEP2=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRDRPH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NP
   52 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF
   53 FORMAT('IMANUF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IGUNIT
   54 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,58)IFIG
   58 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT,JPATT
   59 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST,JJUST
   62 FORMAT('IJUST,JJUST = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR,ANGLE,JDIR
   63 FORMAT('IDIR,ANGLE,JDIR = ',A4,2X,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ICOL,JCOL
   64 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)PTHICK,JTHICK,PTHIC2
   66 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   67 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PHEIG2,PWIDT2,PVEGA2,PHOGA2
   68 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ISYMBL,ISPAC
   71 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP XX--                       **
C               **  TREAT THE BLANK CHARACTER CASE  **
C               **************************************
C
      IF(ISYMBL.EQ.'    ')GOTO9000
      IF(ISYMBL.EQ.'BLAN')GOTO9000
      IF(ISYMBL.EQ.'NONE')GOTO9000
      IF(ISYMBL.EQ.'SPAC')GOTO9000
      IF(ISYMBL.EQ.'BL')GOTO9000
      IF(ISYMBL.EQ.'NO')GOTO9000
      IF(ISYMBL.EQ.'SP')GOTO9000
CCCCC JULY 1996.  IF CHARACTER CASE ASIS SET, THESE WILL BE IN LOWER
CCCCC CASE.  REPEAT FOR LOWER CASE.
      IF(ISYMBL.EQ.'blan')GOTO9000
      IF(ISYMBL.EQ.'none')GOTO9000
      IF(ISYMBL.EQ.'spac')GOTO9000
      IF(ISYMBL.EQ.'bl')GOTO9000
      IF(ISYMBL.EQ.'no')GOTO9000
      IF(ISYMBL.EQ.'sp')GOTO9000
C
C               ********************************************************
C               **  STEP 0--                                          **
C               **  COMPUTE THE INCREMENT TO ALLOW A NEW START POINT  **
C               **  FOR THE MARKER.  THIS IMNCREMENT DEPENDS ON THE   **
C               **  JUSTIFICATION FOR THE MARKER.                     **
C               ********************************************************
C
CCCCC ADD FOLLOWING 2 LINES  JULY 1996.
      IJUSTH='CENT'
      IJUSTV='CENT'
      IF(IJUST.EQ.'LEFT')GOTO910
      IF(IJUST.EQ.'CENT')GOTO920
      IF(IJUST.EQ.'RIGH')GOTO930
C
      IF(IJUST.EQ.'LJUS')GOTO910
      IF(IJUST.EQ.'CJUS')GOTO920
      IF(IJUST.EQ.'RJUS')GOTO930
C
      IF(IJUST.EQ.'LEBO')GOTO910
      IF(IJUST.EQ.'CEBO')GOTO920
      IF(IJUST.EQ.'RIBO')GOTO930
C
      IF(IJUST.EQ.'LECE')GOTO940
      IF(IJUST.EQ.'CECE')GOTO950
      IF(IJUST.EQ.'RICE')GOTO960
C
      IF(IJUST.EQ.'LETO')GOTO970
      IF(IJUST.EQ.'CETO')GOTO980
      IF(IJUST.EQ.'RITO')GOTO990
C
      GOTO910
C
  910 CONTINUE
      PXINC=0.0
      PYINC=0.0
      IJUSTH='LEFT'
      IJUSTV='BOTT'
      GOTO995
C
  920 CONTINUE
      PXINC=PWIDT2/2.0
      PYINC=0.0
      IJUSTH='CENT'
      IJUSTV='BOTT'
      GOTO995
C
  930 CONTINUE
      PXINC=PWIDT2
      PYINC=0.0
      IJUSTH='RIGH'
      IJUSTV='BOTT'
      GOTO990
C
  940 CONTINUE
      PXINC=0.0
      PYINC=PHEIG2/2.0
      IJUSTH='LEFT'
      IJUSTV='CENT'
      GOTO995
C
  950 CONTINUE
      PXINC=PWIDT2/2.0
      PYINC=PHEIG2/2.0
      IJUSTH='CENT'
      IJUSTV='CENT'
      GOTO995
C
  960 CONTINUE
      PXINC=PWIDT2
      PYINC=PHEIG2/2.0
      IJUSTH='RIGH'
      IJUSTV='CENT'
      GOTO990
C
  970 CONTINUE
      PXINC=0.0
      PYINC=PHEIG2
      IJUSTH='LEFT'
      IJUSTV='TOP '
      GOTO995
C
  980 CONTINUE
      PXINC=PWIDT2/2.0
      PYINC=PHEIG2
      IJUSTH='CENT'
      IJUSTV='TOP '
      GOTO995
C
  990 CONTINUE
      PXINC=PWIDT2
      PYINC=PHEIG2
      IJUSTH='RIGH'
      IJUSTV='TOP '
      GOTO995
C
  995 CONTINUE
CCCCC FOLLOWING 2 LINES ADDED MAY 1992.
      PXINC=PXINC*(100.0/(PWXMAX-PWXMIN))
      PYINC=PYINC*(100.0/(PWYMAX-PWYMIN))
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
C               ******************************************************
C
CCCCC SEPTEMBER 1995.  ADD "PIXEL" CAPABILITY.
 1100 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIEN)
      IF(NUMVPP.GE.3000)IFACTO=1
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO1160
C
      DO1110I=1,NP
C
      ICSTR(1:1)=IGSC
      NCSTR=1
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IUSC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ISYMBL(1:1)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 1110 CONTINUE
      GOTO1190
C
 1160 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO1170I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO1175IROW=IX,IX+NCOL-1
          DO1178ICOLZ=IY,IY+NCOL-1
            ICSTR(1:1)=IGSC
            ICSTR(2:2)=IFSC
            NCSTR=2
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ-IYINC
            CALL TKTRPT(IXTEMP,IYTEMP,IFACTO,ICSTR,NCSTR,ISUBN0)
            CALL TKTRPT(IXTEMP,IYTEMP,IFACTO,ICSTR,NCSTR,ISUBN0)
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1178     CONTINUE
 1175   CONTINUE
 1170 CONTINUE
C
 1190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  USE THE p (= MOVE) INSTRUCTION                  **
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  AND THE ~' (= INVOKE LABEL MODE) INSTRUCTION    **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 80-85, 253-254.                 **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 111 AND 112.                    **
C               ******************************************************
C
 2100 CONTINUE
C
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO2160
C
      DO2110I=1,NP
C
      ICSTR(1:1)='p'
      NCSTR=1
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      CALL HPTRPT(IX1P,IY1P,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,2111)(ICTEXT(J),J=1,NCTEP2)
C2111 FORMAT('~''',120A1)
      ICSTR(1:2)='~'''
      ICSTR(3:3)=ISYMBL(1:1)
      ICSTR(4:4)=IETXC
      ICSTR(5:5)='}'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2110 CONTINUE
C
      GOTO2190
C
 2160 CONTINUE
      WRITE(ICOUT,2162)
 2162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE HP-7221 DEVICE.')
      CALL DPWRST('XXX','BUG ')
C
 2190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  USE THE PU (= PEN UP) INSTRUCTION               **
C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  AND THE LB (= LABEL) INSTRUCTION                **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 62, 143.                        **
C               **             PAGE 65-67, 143.                     **
C               **             PAGE 75, 141.                        **
C               ******************************************************
C
CCCCC SEPTEMBER 1995.  ADD SUPPORT FOR PIXEL CAPABILITY
 2200 CONTINUE
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO2260
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
      NCTEP1=NCTEXT+1
      NCTEP2=NCTEXT+2
      ICTEXT(NCTEP1)=IETXC
      ICTEXT(NCTEP2)=';'
C
      DO2210I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2211)IX,IY
C2211 FORMAT('PU;PA',I5,',',I5,';')
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,2212)(ICTEXT(J),J=1,NCTEP2)
C2212 FORMAT('LB',120A1)
      ICSTR(1:2)='LB'
      NCSTR=2
      DO2212J=1,NCTEP2
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 2212 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2210 CONTINUE
      GOTO2290
C
 2260 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      ICSTR(1:14)='1 setlinewidth'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO2270I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        IX=IX-IXINC
        IY=IY-IYINC
        IX2=IX+NCOL-1
        IY2=IY+NCOL-1
        DO2280ICOLZ=IY,IY2
C
          ICSTR(1:5)='PU;PA'
          NCSTR=5
          NCHTOT=5
          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
          ICSTR(11:11)=','
          NCSTR=11
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(17:17)=';'
          NCSTR=17
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:5)='PD;PA'
          NCSTR=5
          NCHTOT=5
          CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
          ICSTR(11:11)=','
          NCSTR=11
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(17:17)=';'
          NCSTR=17
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2280   CONTINUE
 2270 CONTINUE
C
 2290 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-12, 10-13, 10-21.
C               **********************************************************
C
C  MODIFIED JULY, 1990 TO PACK ONTO 1 LINE.
C
CCCCC SEPTEMBER 1995.  ADD PIXEL CAPABILITY.
C
 2300 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO2360
C
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
      NCTEP1=NCTEXT+1
CCCCC NCTEP2=NCTEXT+2
      ICTEXT(NCTEP1)=ICRC
CCCCC ICTEXT(NCTEP2)='Z'
C
      DO2310I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pa'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(16:16)='Z'
      NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='*l'
CCCCCCNCSTR=3
      ICSTR(17:17)=IESCC
      ICSTR(18:19)='*l'
      NCSTR=19
CCCCC DO2312J=1,NCTEP2
      DO2312J=1,NCTEP1
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 2312 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2310 CONTINUE
C
      GOTO2390
C
 2360 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      ICSTR(1:14)='1 setlinewidth'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO2370I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        IX=IX-IXINC
        IY=IY-IYINC
        IX2=IX+NCOL-1
        IY2=IY+NCOL-1
        DO2380ICOLZ=IY,IY2
C
          ICSTR(1:1)=IESCC
          ICSTR(2:4)='*pa'
          NCSTR=4
          NCHTOT=5
          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
          ICSTR(10:10)=','
          NCSTR=10
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(16:16)='Z'
          NCSTR=16
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IESCC
          ICSTR(2:4)='*pb'
          NCSTR=4
          NCHTOT=5
          CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
          ICSTR(10:10)=','
          NCSTR=10
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(16:16)='Z'
          NCSTR=16
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2380   CONTINUE
 2370 CONTINUE
C
 2390 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **  (LASERJET SERIES LASER PRINTERS)                    **
C               **  ESCC *p<X COOR>X<Y COOR>Y - DO A MOVE               **
C               **  SET FONT FIRST IF NEEDED.                           **
C               **  NO  SPECIAL INSTRUCTION REQUIRED TO PUT IN TEXT MODE**
C               **  REFERENCE--HP LASERJET SERIES II TECHNICAL          **
C               **             REFERENCE MANUAL,                        **
C               **********************************************************
C
 2600 CONTINUE
      IF(IPCLFN.NE.IPCLFC)GOTO2605
      IPCLFC=IPCLFN
      ICSTR(1:1)=IESCC
C
      ICSTR(2:5)='(s3T'
      IF(IPCLFN.EQ.'COND')ICSTR(4:4)='0'
      ICSTR(6:6)=IESCC
      ICSTR(7:10)='(s0B'
      IF(IPCLFN.EQ.'CBOL')ICSTR(9:9)='3'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2605 CONTINUE
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
C
      DO2610I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      PY1P=100.-PY1P
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*p'
      NCSTR=3
      NCHTOT=4
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)='X'
      NCSTR=8
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(13:13)='Y'
      ICSTR(14:14)=ICTEXT(NCTEXT)
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2610 CONTINUE
C
 2690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
        WRITE(ICOUT,3102)
        CALL DPWRST('XXX','BUG ')
C
        GOTO9000
      ENDIF
 3102 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE GENERAL DEVICE.')
C
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
C
      IF(IJUSSW.EQ.'ON')GOTO3150
C
      DO3110I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
      PX1P=AX1
      PY1P=AY1
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='WRITE TEXT '
      NCSTR=11
      DO3112J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3112 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3110 CONTINUE
C
      GOTO3190
C
 3150 CONTINUE
C
      DO3160I=1,NP
C
      PX1P=PX(I)
      PY1P=PY(I)
      CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
      PX1P=AX1
      PY1P=AY1
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='WRITE TEXT '
      NCSTR=11
      DO3162J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3162 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3160 CONTINUE
C
 3190 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  DECEMBER 1997.  CODE SLIGHTLY DIFFERENTLY FOR GUI
 3200 CONTINUE
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
        WRITE(ICOUT,3262)
        CALL DPWRST('XXX','BUG ')
C
        GOTO9000
      ENDIF
 3262 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE GENERAL DEVICE.')
C
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
C
      IF(IJUSSW.EQ.'ON')GOTO3250
C
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3230
      DO3210I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
      PX1P=AX1
      PY1P=AY1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3212J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3212 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3210 CONTINUE
      GOTO3290
C
 3230 CONTINUE
      DO3240I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
      IPXTMP=INT(AX1*10.**IGENFA+0.5)
      IPYTMP=INT(AY1*10.**IGENFA+0.5)
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='  '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3242J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3242 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3240 CONTINUE
      GOTO3290
C
 3250 CONTINUE
C
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3270
      DO3260I=1,NP
C
      PX1P=PX(I)
      PY1P=PY(I)
      CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
      PX1P=AX1
      PY1P=AY1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3252J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3252 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3260 CONTINUE
      GOTO3290
C
 3270 CONTINUE
C
      DO3280I=1,NP
C
      CALL GRTRSA(PX(I),PY(I),AX1,AY1,ISUBN0)
      IPXTMP=INT(AX1*10.**IGENFA+0.5)
      IPYTMP=INT(AY1*10.**IGENFA+0.5)
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='  '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3282J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3282 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3280 CONTINUE
 3290 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  TEXT (XCOOR,YCOOR) FINAL "<SYMBOL>";                     **
C               ***************************************************************
C
 3300 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
        WRITE(ICOUT,3362)
        CALL DPWRST('XXX','BUG ')
C
        GOTO9000
      ENDIF
 3362 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE CGM DEVICE.')
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
      NCHTOT=10
      NCHDEC=5
C
      IF(IJUSSW.EQ.'ON')GOTO3350
C
      DO3310I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      ICSTR(1:6)='TEXT ('
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:36)=') FINAL "'
      ICSTR(37:37)=ICTEXT(NCTEXT)
      ICSTR(38:39)='";'
      NCSTR=39
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3310 CONTINUE
C
      GOTO3390
C
 3350 CONTINUE
C
      DO3360I=1,NP
C
      PX1P=PX(I)
      PY1P=PY(I)
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      ICSTR(1:6)='TEXT ('
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:36)=') FINAL "'
      ICSTR(37:37)=ICTEXT(NCTEXT)
      ICSTR(38:39)='";'
      NCSTR=39
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3360 CONTINUE
C
 3390 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               **  USE CALCOMP LIBRARY                             **
C               **      SYMBOL - WRITES TEXT                        **
C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
C               **               PERCENT UNITS TO INCHES            **
C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
C               **               CHARACTER VARIABLE TO HOLLERITH    **
C               **               FORMAT (NOT NECCESARY ON ALL       **
C               **               SYSTEMS, BUT IS ON OTHERS.         **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM CALCOMP DEV.')
CCCCC ICSTR(1:52)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM CALCOMP DEV.'
CCCCC NCSTR=52
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4160
C
      NCTEXT=1
      ICTEXT(1)=ISYMBL
C
      DO4110I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
      ANGLE=0.
      AXTEMP=0.
      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      CALL CALCTR(ICTEXT,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX,AY,HEIGHT,IHOLL,ANGLE,NCTEXT)
C
 4110 CONTINUE
      GOTO4190
C
 4160 CONTINUE
      WRITE(ICOUT,4162)
 4162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE CALCOMP DEVICE.')
      CALL DPWRST('XXX','BUG ')
C
 4190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4660
C
      NCTEXT=1
      ICTEXT(1)=ISYMBL
C
      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
      DO4610I=1,NP
C
      PX1P=PX(I)
      PY1P=PY(I)
      CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
      ICOLMN=INT(REAL(ILAHEY(8))*(AX*RLAHEY(1)/11.0)+0.5)
      IF(IJUSTH.EQ.'RIGH')THEN
        NSHIFT=NCTEXT
      ELSEIF(IJUSTH.EQ.'CENT')THEN
        NSHIFT=NCTEXT/2
      ELSE
        NSHIFT=0
      ENDIF
      ICOLMN=ICOLMN-NSHIFT
      IF(ICOLMN.LT.1)ICOLMN=1
      IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
      ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY)/8.5)+0.5)
      IF(IJUSTV.EQ.'TOP')THEN
        NSHIFT=1
      ELSEIF(IJUSTV.EQ.'CENT')THEN
        NSHIFT=1
      ELSE
        NSHIFT=0
      ENDIF
      ILINE=ILINE-NSHIFT
      IF(ILINE.LT.1)ILINE=1
      IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
      CALL GTEXT(ILINE,ICOLMN,ISYMBL)
C
 4610 CONTINUE
      GOTO4690
C
 4660 CONTINUE
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
      IPEN=JCOL
      DO4670I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL CALCPT(PX1,PY1,AX,AY,ISUBN0)
        CALL SETPIX(AX,AY,IPEN)
C       DO4675IROW=IX,IX+NCOL-1
C         DO4678ICOLZ=IY,IY+NCOL-1
C           AX2=AX+REAL(IX-IROW)
C           AY2=AY+REAL(IY-ICOL)
C           CALL SETPIX(AX,AY,IPEN)
C4678     CONTINUE
C4675   CONTINUE
 4670 CONTINUE
C
 4690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4760
C
      NCTEXT=1
      ICTEXT(1)=ISYMBL
C
      IWIDTH=0
CQWVF IWIDTH=GETGTEXTEXTENT(ISYMBL(1:1))
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=IWIDTH/2
      ELSE
        IXINC=IWIDTH
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=PHEIG2/2
      ELSE
        IYINC=PHEIG2
      ENDIF
C
      DO4710I=1,NP
      PX1P=PX(I)
CCCCC PY1P=100.-PY(I)
      PY1P=PY(I)
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CQWVF CALL MOVETO(INT2(IX-IXINC),INT2(IY-IYINC),WXY)
CQWVF CALL OUTGTEXT(ISYMBL)
 4710 CONTINUE
      GOTO4790
C
CCCCC NOTE: QWIN DRIVER CURRENTLY SET TO USE 0 TO 100 COORDINATES.
CCCCC       THIS DOESN'T WORK SO WELL IF SETTING MULTIPLE PIXELS,
CCCCC       DOING IMAGE STUFF, ETC.  NEED TO UPDATE ALGORITHM BELOW
CCCCC       TO CONVERT PERCENTAGES TO ACTUAL PIXELS.  CURRENTLY, LIMIT
CCCCC       TO DRAWING A SINGLE PIXEL.
 4760 CONTINUE
C
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO4770I=1,NP
        PX1=PX(I)
CCCCC   PY1=100.-PY(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO4775IROW=IX,IX+NCOL-1
          DO4778ICOLZ=IY,IY+NCOL-1
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ-IYINC
CQWVF       IRESLT=SETPIXEL(INT2(IXTEMP),INT2(IYTEMP))
 4778     CONTINUE
 4775   CONTINUE
 4770 CONTINUE
C
 4790 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IOPGOF.EQ.'OFF')GOTO9000
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4860
C
      CALL DPCOAN(ISYMBL(1:1),IJUNK)
      STRING(1)=IJUNK
      STRING(2)=0
C
      ILAST=80
      DO4810I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO4819
 4810 CONTINUE
 4819 CONTINUE
      DO4820I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 4820 CONTINUE
      IADE(ILAST+1)=0
C
      CALL GLTATT(IADE,IGLERR)
      IF(IGLERR.EQ.1) THEN
        WRITE(ICOUT,4821)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IGLERR.EQ.2)THEN
        WRITE(ICOUT,4822)
        CALL DPWRST('XXX','BUG ')
      END IF
 4821 FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND.  USE ',
     1'CURRENT FONT.')
 4822 FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND.  USE ',
     1'DEFAULT FONT.')
C
      IGLERR=0
C
      DO4850I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        CALL GLTEXH(STRING,IX,IY,IFONTH,IFONTV,IGLERR)
        IF(IGLERR.GT.0)THEN
          WRITE(ICOUT,4852)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 4852   FORMAT(1X,'ERROR: OPEN-GL PLOT SYMBOL RETURNED AN ERROR.')
 4850 CONTINUE
      GOTO4899
C
 4860 CONTINUE
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO4870I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO4875IROW=IX,IX+NCOL-1
          DO4878ICOLZ=IY,IY-NCOL+1,-1
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ+IYINC
            CALL GLPOIN(IXTEMP,IYTEMP,NCOL)
 4878     CONTINUE
 4875   CONTINUE
 4870 CONTINUE
C
 4899 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4930
      GOTO4949
C
 4930 CONTINUE
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO4938I=1,NP
CINTE   CALL IGrPoint(PX(I),PY(I))
 4938 CONTINUE
      GOTO4999
C
 4949 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4980
      GOTO4999
C
 4980 CONTINUE
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO4988I=1,NP
CWINT   CALL IGrPoint(PX(I),PY(I))
 4988 CONTINUE
      GOTO4999
C
 4999 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               **  USE CALCOMP LIBRARY                             **
C               **      SYMBOL - WRITES TEXT                        **
C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
C               **               PERCENT UNITS TO INCHES            **
C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
C               **               CHARACTER VARIABLE TO HOLLERITH    **
C               **               FORMAT (NOT NECCESARY ON ALL       **
C               **               SYSTEMS, BUT IS ON OTHERS.         **
C               ******************************************************
C
 5100 CONTINUE
CCCCC IC4=ISYMBL
CCCCC IC=IC4(1:4)
CCCCC CALL ZETRCH(IC,IC1,IC2)
C
CCCCC DO5110I=1,NP
C
CCCCC ICSTR(1:1)='1'
CCCCC NCSTR=1
C
CCCCC PX1P=PX(I)-PXINC
CCCCC PY1P=PY(I)-PYINC
CCCCC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
C
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='3'
C
CCCCC PXDEL=PWIDT2+PHOGA2
CCCCC PYDEL=PHEIG2+PVEGA2
CCCCC CALL GRTRSD(PXDEL,PYDEL,IXW,IYH,ISUBN0)
CCCCC CALL ZETRPT(IXW,IYH,ICSTR,NCSTR,ISUBN0)
C
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='0'
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='1'
C
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC1
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC2
C
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C5110 CONTINUE
C
C5190 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO5160
C
      NCTEXT=1
      ICTEXT(1)=ISYMBL
C
      DO5110I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
      ANGLE=0.
      AXTEMP=0.
      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      CALL CALCTR(ICTEXT,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX,AY,HEIGHT,IHOLL,ANGLE,NCTEXT)
C
 5110 CONTINUE
C
      GOTO5190
C
 5160 CONTINUE
      WRITE(ICOUT,5162)
 5162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE ZETA DEVICE.')
      CALL DPWRST('XXX','BUG ')
C
 5190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM RAMTEK DEV.')
      ICSTR(1:51)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM RAMTEK DEV.'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               **  WRITTEN BY BILL ANDERSON                        **
C               ******************************************************
C
 6600 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO6660
C
      ICSTR(1:1)=ISYMBL(1:1)
      ITEMP=0
      CALL DPCONA(ITEMP,ICSTR(2:2))
C
      DO6610I=1,NP
C
      PX1P = PX(I)-PXINC
      PY1P = PY(I)-PYINC
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
CSUN  CALL cftext(IX1P,IY1P,ICSTR(1:2))
 6610 CONTINUE
C
      GOTO6690
C
 6660 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO6670I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        IX2=IX+NCOL-1
        IY2=IY+NCOL-1
CSUN    CALL cfrectangle(IX,IY,IX2,IY2)
 6670 CONTINUE
C
 6690 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM XXXXXX DEV.')
      ICSTR(1:52)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM XXXXXX DEV.'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
C               **  USE THE P [ X, Y ] (= POSITION) INSTRUCTION     **
C               **  WITH INTEGER COORDINATES,                       **
C               **  AND THE   T ' STRING '  (= TEXT) INSTRUCTION    **
C               **  WITH THE DESIRED TEXT STRING,                   **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 100 AND 118                    **
C               ******************************************************
C
C  MARCH, 1991.  PACK REGIS OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW
C  RATHER THAN ABOVE THE CURSUR POSITION (AS DATAPLOT ASSUMES), SO ADJUST
C  Y COORDINATE BY ONE CHARACTER POSITION.
C
CCCCC SEPTEMBER 1995.  ADD "PIXEL" CAPABILITY.  DO A MOVE, THEN A V[]
CCCCC INSTRUCTION.
 8100 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO8160
C
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
      NCTEP1=NCTEXT+1
      ICTEXT(NCTEP1)=''''
C
      NCSTR=0
      NCHTOT=5
      MAXREG=130
      ISIZE=16+NCTEP1
      DO8110I=1,NP
C
      IF(NCSTR.GT.MAXREG-ISIZE)THEN
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=0
      END IF
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      PY1P=PY1P+PHEIG2
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)='P['
      NCSTR=NCSTR2
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=']'
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='T'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=''''
      DO8112J=1,NCTEP1
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 8112 CONTINUE
      NCSTR=K
C
 8110 CONTINUE
      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO8190
C
 8160 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO8170I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO8175IROW=IX,IX+NCOL-1
          DO8178ICOLZ=IY,IY-NCOL+1,-1
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ+IYINC
C
            ICSTR(1:2)='P['
            NCSTR=2
            NCHTOT=5
            CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
            ICSTR(8:8)=','
            NCSTR=8
            CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
            ICSTR(14:14)=']'
            ICSTR(15:17)='V[]'
            NCSTR=17
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 8178     CONTINUE
 8175   CONTINUE
 8170 CONTINUE
C
 8190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **    XCOOR YCOOR MOVETO  (USE UNADJUSTED COORD.)   **
C               **  (ISYMBL) SHOW                                   **
C               **  RIGHTSHOW AND CENTSHOW ARE DATAPLOT DEFINED     **
C               **  PROCEDURES FOR PRINTING RIGHT AND CENTER        **
C               **  JUSTIFIED STRINGS RESPECTIVELY                  **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **             COOKBOOOK,  ADOBE SYSTEMS            **
C               **  PAGE--37                                        **
C               ** CHECK FOR "(", ")", AND BACKSLASH.  IF FOUND,    **
C               ** PRECEDE WITH A BACKSLASH                         **
C               ******************************************************
CCCCC OCTOBER 1991.  MAKE POSTSCRIPT FONTS TABLE DRIVEN.
CCCCC SEPTEMBER 1995.  ADD PIXEL CAPABILITY.
C
 8600 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO8660
C
      PHEIPP=ANUMVP*PHEIG2/100.
      IPSTPS=INT(PHEIPP+0.5)
      IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605
C  FOLLOWING CODE MODIFIED OCTOBER 1991.
      IJUNK=7
      DO8695I=1,IPSTMF
      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
      IJUNK=I
      GOTO8697
 8695 CONTINUE
 8697 CONTINUE
      ICSTR(1:1)='/'
      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
      ICSTR(42:51)=' findfont '
      NCHTOT=5
      NCSTR=51
      CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+17
      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:33)='/Times-Roman            findfont '
CCCCC IF(IPSTFN.EQ.'TBOL')
CCCCC1ICSTR(1:23)='/Times-Bold            '
CCCCC IF(IPSTFN.EQ.'TITA')
CCCCC1ICSTR(1:23)='/Times-Italic          '
CCCCC IF(IPSTFN.EQ.'TBIT')
CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
CCCCC IF(IPSTFN.EQ.'HELV')
CCCCC1ICSTR(1:23)='/Helvetica             '
CCCCC IF(IPSTFN.EQ.'HELB')
CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
CCCCC IF(IPSTFN.EQ.'HELO')
CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
CCCCC IF(IPSTFN.EQ.'HEBO')
CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
CCCCC IF(IPSTFN.EQ.'COUR')
CCCCC1ICSTR(1:23)='/Courier               '
CCCCC IF(IPSTFN.EQ.'CBOL')
CCCCC1ICSTR(1:23)='/Courier-Bold          '
CCCCC IF(IPSTFN.EQ.'COBL')
CCCCC1ICSTR(1:23)='/Courier-Oblique       '
CCCCC IF(IPSTFN.EQ.'CBOB')
CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
CCCCC NCSTR=33
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(39:56)=' scalefont setfont'
CCCCC NCSTR=56
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  END OF CHANGE
      IPSTFC=IPSTFN
      IPSTPC=IPSTPS
C
 8605 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      IF(ISYMBL.NE.'('.AND.ISYMBL.NE.')'.AND.ISYMBL.NE.IBASLC)GOTO8608
      ICTEXT(1)=IBASLC
      NCTEXT=2
      ICTEXT(NCTEXT)=ISYMBL
      GOTO8609
 8608 CONTINUE
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
 8609 CONTINUE
C
      DO8610I=1,NP
C
CCCCC 6 LINES IN THE FOLLOWING SECTION WERE FIXED   MAY 1991 (ALAN)
      PX1P=PX(I)
      PY1P=PY(I)-PYINC
CCCCC ICSTR(1:3)='/IX '
      ICSTR(1:4)='/IX '
CCCCC NCSTR=3
      NCSTR=4
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(9:17)=' def /IY '
      ICSTR(10:18)=' def /IY '
CCCCC NCSTR=17
      NCSTR=18
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(23:28)=' def ('
      ICSTR(24:29)=' def ('
CCCCC NCSTR=28
      NCSTR=29
      DO8620J=1,NCTEXT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEXT(J)
 8620 CONTINUE
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)=') '
      NCSTR=NCSTR2+1
      NCSTR2=NCSTR+8
      IF(IJUST(1:1).EQ.'L')ICSTR(NCSTR:NCSTR2)='leftshow '
      IF(IJUST(1:1).EQ.'C')ICSTR(NCSTR:NCSTR2)='centshow '
      IF(IJUST(1:1).EQ.'R')ICSTR(NCSTR:NCSTR2)='rightshow'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 8610 CONTINUE
      GOTO8690
C
 8660 CONTINUE
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      ICSTR(1:14)='1 setlinewidth'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO8670I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        IX=IX-IXINC
        IY=IY-IYINC
        IX2=IX+NCOL-1
        IY2=IY+NCOL-1
        DO8680ICOLZ=IY,IY2
          ICSTR(1:8)='newpath '
          NCSTR=8
          NCHTOT=5
          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
          ICSTR(14:14)=' '
          NCSTR=14
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(20:27)=' moveto '
          NCSTR=27
          CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
          ICSTR(33:33)=' '
          NCSTR=33
          CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
          ICSTR(39:52)=' lineto stroke'
          NCSTR=52
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8680   CONTINUE
 8670 CONTINUE
C
 8690 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC LANDSCAPE AND PORTRAIT CASE      **
C               **  <ICARAT>IVvvvvv   - VERTICAL POSITION           **
C               **  <ICARAT>IHhhhhh   - HORIZONTAL POSITION         **
C               **  REFERENCE: QUIC PROGRAMMERS MANUAL -            **
C               **                                                  **
C               ******************************************************
C
 9100 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
        WRITE(ICOUT,9162)
        CALL DPWRST('XXX','BUG ')
C
        GOTO9000
      ENDIF
 9162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE QMS DEVICE.')
C
      CALL DPCONA(94,ICARAT)
C
      IFONTT=IQUIFN
      IF(IORNSW.EQ.'PORT'.AND.(
     1IFONTT.EQ.521.OR.
     1IFONTT.EQ.522.OR.
     1IFONTT.EQ.523.OR.
     1IFONTT.EQ.524))IFONTT=10
      IF(IORNSW.NE.'PORT'.AND.(
     1IFONTT.EQ.124.OR.
     1IFONTT.EQ.144.OR.
     1IFONTT.EQ.16.OR.
     1IFONTT.EQ.328.OR.
     1IFONTT.EQ.998.OR.
     1IFONTT.EQ.404.OR.
     1IFONTT.EQ.444.OR.
     1IFONTT.EQ.532))IFONTT=10
      IF(IFONTT.EQ.IQUIFC)GOTO9105
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IS'
      IQUIFC=IFONTT
      KFONT=IFONTT
      NCHTOT=-5
      NCSTR=3
      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9105 CONTINUE
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
      NCSTR=0
      ANUMPP=ANUMHP
      IF(IJUST(1:1).EQ.'L')GOTO9109
      PXINC=PWIDT2
      IF(IFONTT.EQ.10)GOTO9108
      IF(IFONTT.EQ.404)GOTO9108
      IF(IFONTT.EQ.444)GOTO9108
      IF(IFONTT.EQ.521)GOTO9108
      IF(IFONTT.EQ.522)GOTO9108
      IF(IFONTT.EQ.523)GOTO9108
      IF(IFONTT.EQ.524)GOTO9108
      IF(IFONTT.EQ.532)GOTO9108
      IF(IFONTT.EQ.904)GOTO9108
      IF(IFONTT.EQ.924)GOTO9108
      IF(IFONTT.EQ.536)GOTO9108
      IF(IFONTT.EQ.517)GOTO9108
      IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
      PXINC=PXLECG
C
 9108 CONTINUE
      IF(IJUST(1:1).EQ.'C')PXINC=PXINC/2.
 9109 CONTINUE
C
      NCHTOT=-5
      DO9110I=1,NP
C
      PX1P=PX(I)-PXINC
      PY1P=PY(I)-PYINC
      PY1P=100.-PY1P
      CALL QUICPT(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(6:6)=ICARAT
      ICSTR(7:8)='IH'
      NCSTR=8
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=ICARAT
      ICSTR(15:16)='IV'
      NCSTR=16
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(22:22)=ICTEXT(NCTEXT)
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9110 CONTINUE
C
 9190 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
CCCCC SEPTEMBER 1995.  ADD "PIXEL" SYMBOL.  THIS IS A SPECIAL CASE
CCCCC TO TURN ON A SINGLE PIXEL.  IN THIS CASE, THE PHEIGH VARIABLE
CCCCC IS INTERPRETED AS AN INTEGER SCALE FACTOR, I.E. CHARACTER SIZE
CCCCC 6 WILL DRAW A PIXEL BOX 6 WIDE AND 6 HIGH.  THIS CAPABILITY BEING
CCCCC ADDED FOR FUTURE PLANNED IMPLEMENTATIONS, FOR EXAMPLE TO DO
CCCCC SOME IMAGE PROCESSING.
 9600 CONTINUE
C
      IF(IX11OF.EQ.'OFF')GOTO9000
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO9660
C
      CALL DPCOAN(ISYMBL(1:1),IJUNK)
      STRING(1)=IJUNK
      STRING(2)=0
C
      ILAST=80
      DO9610I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO9619
 9610 CONTINUE
 9619 CONTINUE
      DO9620I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 9620 CONTINUE
      IADE(ILAST+1)=0
C
      CALL XTATTR(IADE,IXERR)
      IF(IXERR.EQ.1) THEN
        WRITE(ICOUT,9621)
      CALL DPWRST('XXX','BUG ')
      ELSEIF(IXERR.EQ.2)THEN
        WRITE(ICOUT,9622)
      CALL DPWRST('XXX','BUG ')
      END IF
 9621 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND.  USE CURRENT FONT.')
 9622 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND.  USE DEFAULT FONT.')
C
      IXERR=0
C
      DO9650I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR)
 9650 CONTINUE
      GOTO9699
C
 9660 CONTINUE
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO9670I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO9675IROW=IX,IX+NCOL-1
          DO9678ICOLZ=IY,IY-NCOL+1,-1
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ+IYINC
            CALL XPOINT(IXTEMP,IYTEMP)
 9678     CONTINUE
 9675   CONTINUE
 9670 CONTINUE
C
 9699 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 124, 113.    **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 324-325, 256.              **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 59-60, 54-55**
C               *************************************************
C
10000 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
        WRITE(ICOUT,10162)
        CALL DPWRST('XXX','BUG ')
C
        GOTO9000
      ENDIF
10162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
     1'THE VGA DEVICE.')
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN    SEPTEMBER 1995
      IF(ITCST.EQ.'CLOS')GOTO10099
C
      NCTEXT=1
      ICTEXT(NCTEXT)=ISYMBL
C
      IC4='CECE'
      CALL TCSEJU(IC4)
      DO10100I=1,NP
         PX1P=PX(I)
         PY1P=PY(I)
         CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
         PX1P=AX1
         PY1P=AY1
         CALL TCMOTO(PX1P,PY1P)
         CALL TCWRTE(ICTEXT,NCTEXT)
10100 CONTINUE
10099 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO12660
C
      CALL DPCOAN(ISYMBL(1:1),IJUNK)
      STRING(1)=IJUNK
      STRING(2)=0
C
      DO12650I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        CALL GDTXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR)
12650 CONTINUE
      GOTO12699
C
12660 CONTINUE
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
      DO12670I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        DO12675IROW=IX,IX+NCOL-1
          DO12678ICOLZ=IY,IY-NCOL+1,-1
            IXTEMP=IROW-IXINC
            IYTEMP=ICOLZ+IYINC
            CALL GDPOIN(IXTEMP,IYTEMP,JCOL)
12678     CONTINUE
12675   CONTINUE
12670 CONTINUE
C
12699 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO15660
C
      IF(IJUST.EQ.'LEFT')THEN
        ICJUNK='bl'
      ELSEIF(IJUST.EQ.'CENT')THEN
        ICJUNK='bc'
      ELSEIF(IJUST.EQ.'RIGH')THEN
        ICJUNK='br'
      ELSEIF(IJUST.EQ.'LJUS')THEN
        ICJUNK='bl'
      ELSEIF(IJUST.EQ.'CJUS')THEN
        ICJUNK='bc'
      ELSEIF(IJUST.EQ.'RJUS')THEN
        ICJUNK='br'
      ELSEIF(IJUST.EQ.'LEBO')THEN
        ICJUNK='bl'
      ELSEIF(IJUST.EQ.'CEBO')THEN
        ICJUNK='bc'
      ELSEIF(IJUST.EQ.'RIBO')THEN
        ICJUNK='br'
      ELSEIF(IJUST.EQ.'LECE')THEN
        ICJUNK='cl'
      ELSEIF(IJUST.EQ.'CECE')THEN
        ICJUNK='cc'
      ELSEIF(IJUST.EQ.'RICE')THEN
        ICJUNK='cr'
      ELSEIF(IJUST.EQ.'LETO')THEN
        ICJUNK='tl'
      ELSEIF(IJUST.EQ.'CETO')THEN
        ICJUNK='tc'
      ELSEIF(IJUST.EQ.'RITO')THEN
        ICJUNK='tr'
      ELSE
        ICJUNK='cc'
      ENDIF
C
      DO15650I=1,NP
C
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:5)='put('
        NCSTR=5
        NCHTOT=5
        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
        ICSTR(NCSTR+2:NCSTR+2)=IBASLC
        NCSTR=NCSTR+15
        ICSTR(NCSTR+1:NCSTR+2)=ICJUNK(1:2)
        NCSTR=NCSTR+2
C
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=']'
C
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='{'
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=ISYMBL(1:1)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)='}}'
        NCSTR=NCSTR+1
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
15650 CONTINUE
      GOTO15699
C
C     FOR LATEX DRIVER, "PIXEL" MODE NOT CURRENTLY SUPPORTED
C
15660 CONTINUE
      GOTO15699
C
15699 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL DPCONA(34,IQUOTE)
C
      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO16060
C
      JHEIG2=(ANUMVP/100.0)*PHEIG2 + 0.5
      DO16010I=1,NP
C
        PX1P=PX(I)
        PY1P=PY(I)-PYINC
        CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
C
        ICSTR(1:11)='   <text x='
        NCSTR=12
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCHTOT=5
        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+2)=' y='
        NCSTR=NCSTR+3
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(ISVGSS(1:3).EQ.'EXT')THEN
          NCSTR=12
          ICSTR(1:NCSTR)='      class='
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=NCSTR+1
C
          IF(IJUSTH.EQ.'CENT')THEN
            ICSTR(NCSTR:NCSTR+16)='center-horizontal'
            NCSTR=NCSTR+17
          ELSEIF(IJUSTH.EQ.'LEFT')THEN
            ICSTR(NCSTR:NCSTR+14)='left-horizontal'
            NCSTR=NCSTR+15
          ELSEIF(IJUSTH.EQ.'RIGH')THEN
            ICSTR(NCSTR:NCSTR+15)='right-horizontal'
            NCSTR=NCSTR+16
          ENDIF
C
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          CALL GRTRCO('FORE',ISVGFC,JCOL2)
          IFLAG=0
          IF(JCOL2.NE.JCOL)THEN
            IFLAG=1
            ICSTR(1:12)='      style='
            ICSTR(13:13)=IQUOTE
            NCSTR=-13
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
            ICSTR(1:21)='             stroke:#'
            NCSTR=21
            NCHTOT=2
            JTEMP=JCOL
            IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
            JRED=IRED(JTEMP)
            CALL DPCONX(JRED,ICJUNK)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
            NCSTR=NCSTR+1
            JGREEN=IGREEN(JTEMP)
            CALL DPCONX(JGREEN,ICJUNK)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
            NCSTR=NCSTR+1
            JBLUE=IBLUE(JTEMP)
            CALL DPCONX(JBLUE,ICJUNK)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
            NCSTR=NCSTR+2
            ICSTR(NCSTR:NCSTR)=';'
            NCSTR=-NCSTR
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ENDIF
          IF(JHEIG2.NE.9)THEN
            IF(IFLAG.EQ.0)THEN
              ICSTR(1:12)='      style='
              ICSTR(13:13)=IQUOTE
              NCSTR=-13
              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
              IFLAG=1
            ENDIF
            NCSTR=22
            ICSTR(1:NCSTR)='            font-size:'
            NCHTOT=3
            CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=';'
            NCSTR=-NCSTR
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ENDIF
          IF(IFLAG.EQ.1)THEN
            NCSTR=13
            ICSTR(1:NCSTR)='             '
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=IQUOTE
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)='>'
            NCSTR=-NCSTR
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ENDIF
C
        ELSE
          NCSTR=14
          ICSTR(1:NCSTR)='        style='
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=IQUOTE
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          IF(IJUSTH.EQ.'CENT')THEN
            NCSTR=29
            ICSTR(1:NCSTR)='         text-anchor:Middle;'
          ELSEIF(IJUSTH.EQ.'RIGH')THEN
            NCSTR=25
            ICSTR(1:NCSTR)='         text-anchor:End;'
          ELSE
            NCSTR=28
            ICSTR(1:NCSTR)='         text-anchor:Start;'
          ENDIF
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          NCSTR=21
          ICSTR(1:NCSTR)='         font-family:'
          DO16002II=32,1,-1
            NCTEMP=II
            IF(ISVGFN(II:II).NE.' ')GOTO16003
16002     CONTINUE
16003     CONTINUE
           NCSTR=NCSTR+1
           ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
           NCSTR=NCSTR+NCTEMP
           ICSTR(NCSTR:NCSTR)=';'
           NCSTR=-NCSTR
           CALL GRWRST(ICSTR,NCSTR,ISUBN0)
           IF(ISVGFW.EQ.'NORM')THEN
             NCSTR=28
             ICSTR(1:NCSTR)='         font-weight:normal;'
             NCSTR=-NCSTR
           ELSE
             NCSTR=26
             ICSTR(1:NCSTR)='         font-weight:bold;'
             NCSTR=-NCSTR
           ENDIF
           CALL GRWRST(ICSTR,NCSTR,ISUBN0)
           IF(ISVGST.EQ.'ITAL')THEN
             NCSTR=27
             ICSTR(1:NCSTR)='         font-style:italic;'
             NCSTR=-NCSTR
           ELSE
             NCSTR=27
             ICSTR(1:NCSTR)='         font-style:normal;'
             NCSTR=-NCSTR
           ENDIF
           NCSTR=19
           ICSTR(1:NCSTR)='         font-size:'
           NCHTOT=3
           CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
           NCSTR=NCSTR+1
           ICSTR(NCSTR:NCSTR)=';'
           NCSTR=-NCSTR
           CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          NCSTR=17
          ICSTR(1:NCSTR)='         stroke:#'
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          NCSTR=9
          ICSTR(1:NCSTR)='         '
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='>'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ENDIF
C
        DO16012J=1,4
          ICSTR(J:J)=ISYMBL(J:J)
16012   CONTINUE
        NCSTR=-4
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:10)='   </text>'
        NCSTR=-10
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
16010 CONTINUE
      GOTO16090
C
CCCCC "PIXEL" OPTION: USE FILLED RECTANGLE TO DRAW
16060 CONTINUE
C
      IFONTH=0
      IF(IJUSTH.EQ.'C')IFONTH=1
      IF(IJUSTH.EQ.'R')IFONTH=2
      IFONTV=0
      IF(IJUSTV.EQ.'B')IFONTV=1
      IF(IJUSTV.EQ.'T')IFONTV=2
      NCOL=INT(PHEIGH)
      IF(NCOL.LT.1)NCOL=1
      IF(IFONTH.EQ.0)THEN
        IXINC=0
      ELSEIF(IFONTH.EQ.1)THEN
        IXINC=NCOL/2
      ELSE
        IXINC=NCOL
      ENDIF
      IF(IFONTV.EQ.0)THEN
        IYINC=0
      ELSEIF(IFONTV.EQ.1)THEN
        IYINC=NCOL/2
      ELSE
        IYINC=NCOL
      ENDIF
C
      DO16070I=1,NP
        PX1=PX(I)
        PY1=PY(I)
        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
        IX=IX-IXINC
        IY=IY-IYINC
        IX2=IX+NCOL-1
        IY2=IY+NCOL-1

        ICSTR(1:11)='   <rect x='
        ICSTR(12:12)=IQUOTE
        NCSTR=12
        NCHTOT=5
        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+2)=' y='
        NCSTR=NCSTR+3
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:15)='         width='
        ICSTR(16:16)=IQUOTE
        NCSTR=16
        CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+7)=' height='
        NCSTR=NCSTR+8
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:17)='           style='
        ICSTR(18:18)=IQUOTE
        ICSTR(19:31)='stroke:none; '
        NCSTR=-31
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:19)='             fill:#'
        NCSTR=19
        NCHTOT=2
        JTEMP=JCOL
        IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+2
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:7)='     />'
        NCSTR=-7
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16070 CONTINUE
C
16090 CONTINUE
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRDRPH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NP
 9012 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMANUF
 9013 FORMAT('IMANUF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IGUNIT
 9014 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9018)IFIG
 9018 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,ANGLE,JDIR
 9023 FORMAT('IDIR,ANGLE,JDIR = ',A4,2X,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ICOL,JCOL
 9024 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)PTHICK,JTHICK,PTHIC2
 9026 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9027 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9028 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)IJUST,PXINC,PYINC
 9030 FORMAT('IJUST,PXINC,PYINC = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISYMBL,ISPAC
 9031 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)PXDEL,PYDEL
 9032 FORMAT('PXDEL,PYDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISYMBL,IC4,IC,IC1,IC2
 9033 FORMAT('ISYMBL,IC4,IC,IC1,IC2 = ',A4,2X,A4,2X,A1,2X,A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)NCSTR
 9043 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9047
      DO9045I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
 9046 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9045 CONTINUE
 9047 CONTINUE
      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              DRAW THE POLYLINE WHOSE COORDINATES
C              ARE GIVEN IN (PX(.),PY(.)).
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1990. PACK HP-GL OUTPUT (BY ALAN HECKERT)
C     UPDATED         --JUNE     1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --JULY     1990. PACK HP-2622 COORDINATES
C     UPDATED         --AUGUST   1990. BUG FIX IN POSTSCRIPT
C     UPDATED         --SEPTEMBER1990. BUG FIX IN SUN
C     UPDATED         --MARCH    1991. PACK REGIS OUTPUT
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --SEPTEMBER 1995. VGA/TURBOC MULTIPLOTTING
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. FIX BLANK LINE FOR SOME DEVICES
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. UPDATE TO GENERAL CODED FOR
C                                      GUI.
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FORM
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT THE LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC FOLLOWING FOR OPEN/GL
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
      CHARACTER*4 QWSCRN
      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
CQWVF TYPE (XYCOORD)   WXY
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*2 ICJUNK
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION PX(*)
      DIMENSION PY(*)
CCCCC THE FOLLOWING 5 LINES WERE ADDED     SEPTEMBER 1995
CCCCC TO SOLVE THE "WANDERING" TIC MARK PROBLEM
CCCCC WITH MULTIPLOTTING ON THE PC TURBO-C FRONTEND
      DIMENSION PXP(MAXPOP)
      DIMENSION PYP(MAXPOP)
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGRG15),PXP(1))
      EQUIVALENCE (G2RBAG(IGRG16),PYP(1))
C
C  FOLLOWING DIMENSION STATEMENT FOR THE SUN CASE
      DIMENSION IPX(MAXPOP)
      DIMENSION IPY(MAXPOP)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (IGARBG(IIGAG1),IPX(1))
      EQUIVALENCE (IGARBG(IIGAG2),IPY(1))
CCCCC END CHANGE
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*1 ICARAT
      CHARACTER*1 IQUOTE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XDRAW
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='DRPL'
C
      NCSTR=(-999)
      ISAVE=(-999)
C
      NLOOP=0
      DEL=0.0
      AI=0.0
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRDRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IGUNIT
   52 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NP
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,MAX(10,NP)
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,58)IFIG
   58 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT,JPATT
   59 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)PTHICK,JTHICK,PTHIC2
   60 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICOL,JCOL
   61 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IMODEL
   63 FORMAT('IMODEL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4027')GOTO1200
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               **************************************************************
C               **  STEP 11--                                               **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES    **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)        **
C               **  TO DRAW A POLYLINE,  DO THE FOLLOWING--
C               **  STEP 1--SET THE MODE AS GRAPHICS MODE                   **
C               **         (AS OPPOSED TO ALPHANUMERIC MODE)                **
C               **  STEP 2--TRANSLATE THE COORDINATES FOR THE START POINT.  **
C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX          **
C               **  STEP 3--TRANSLATE THE COORDINATES FOR THE STOP POINT.   **
C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX          **
C               **  STEP 4--WRITE OUT THE MODE PLUS (ON THE SAME LINE)      **
C               **          THE 2 TRANSLATED PAIRS OF COORDINATE POINTS.    **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1100 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (TO ALLOW PORT, SQUARE ORIENT)
      IF(NUMVPP.GE.3000)IFACTO=1
      IF(NP.LE.0)GOTO1190
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
C
 1105 CONTINUE
      IF(IMODEL.EQ.'4006'.OR.IMODEL.EQ.'4010')GOTO1106
      GOTO1107
 1106 CONTINUE
      ICSTR(1:1)=IGSC
      NCSTR=1
      ISAVE=NCSTR
      GOTO1109
 1107 CONTINUE
      ICSTR(1:1)=IESCC
CCCCC ICSTR(2:2)=CHAR(JPATT)
      CALL DPCONA(JPATT,ICSTR(2:2))
      ICSTR(3:3)=IGSC
      NCSTR=3
      ISAVE=NCSTR
      GOTO1109
 1109 CONTINUE
C
      I=0
      I=I+1
C
 1110 CONTINUE
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
C
 1120 CONTINUE
      I=I+1
      IF(I.GT.NP)GOTO1140
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
C
      IF(NCSTR.GE.70)GOTO1130
      GOTO1120
C
 1130 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC NCSTR=3
CCCCC GOTO1110
CCCCC GOTO1105
      NCSTR=ISAVE
      GOTO1110
C
 1140 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO1190
C
 1190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4027 CASE                   **
C               **  (COLOR RASTER DEVICE).                          **
C               **  TO DRAW A POLYLINE,  DO THE FOLLOWING--         **
C               **  STEP 1--SET THE MODE AS GRAPHICS MODE           **
C               **         (AS OPPOSED TO ALPHANUMERIC MODE)        **
C               **  STEP 2--TRANSLATE THE COORDINATES FOR THE       **
C               **          START POINT.                            **
C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX  **
C               **  STEP 3--TRANSLATE THE COORDINATES FOR THE       **
C               **          STOP POINT.                             **
C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX  **
C               **  STEP 4--WRITE OUT THE MODE PLUS (ON THE SAME LIN**
C               **          THE 2 TRANSLATED PAIRS OF COORDINATE POI**
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1200 CONTINUE
      NPM1=NP-1
      IF(NPM1.LE.0)GOTO1290
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      I=0
      IP1=I+1
      CALL GRTRSD(PX(IP1),PY(IP1),IX2,IY2,ISUBN0)
      DO1210I=1,NPM1
      IP1=I+1
      IX1=IX2
      IY1=IY2
      IP1=I+1
      CALL GRTRSD(PX(IP1),PY(IP1),IX2,IY2,ISUBN0)
CCCCC WRITE(IGUNIT,1211)IX1,IY1,IX2,IY2
C1211 FORMAT('!VEC ',4I8)
      ICSTR(1:5)='!VEC '
      NCSTR=5
      NCHTOT=8
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1210 CONTINUE
 1290 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO DRAW A POLYLINE--                            **
C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION                  *
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  AND THE LOWER CASE Q (= DRAW) INSTRUCTION                  *
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 80-85, 253-254.                 **
C               ******************************************************
C
 2100 CONTINUE
      IF(NP.LE.0)GOTO2190
      I=1
      ICSTR(1:1)='p'
      NCSTR=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(NP.LE.1)GOTO2190
      DO2120I=2,NP
      ICSTR(1:1)='q'
      NCSTR=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2120 CONTINUE
 2190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO DRAW A POLYLINE--                            **
C               **  USE THE PU (= PEN UP) INSTRUCTION               **
C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  AND THE PD (= PEN DOWN) INSTRUCTION             **
C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 62, 143.                        **
C               **             PAGE 65-67, 143.                     **
C               ******************************************************
C
C  MODIFIED MAY, 1990 (PACK THE OUTPOUT FOR A SMALLER FILE)
 2200 CONTINUE
CCCCC IF(NP.LE.0)GOTO2290
      IF(NP.LE.1)GOTO2290
C
      I=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2211)IX,IY
C2211 FORMAT('PU;PA',I5,',',I5,';')
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      ICSTR(18:20)='PD;'
      NCSTR=20
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC IF(NP.LE.1)GOTO2290
      ICSTR(1:2)='PA'
      NCSTR=2
      NCHTOT=5
      DO2220I=2,NP
C
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2221)IX,IY
C2221 FORMAT('PD;PA',I5,',',I5,';')
CCCCC ICSTR(1:5)='PD;PA'
CCCCC NCSTR=5
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(11:11)=','
CCCCC NCSTR=11
CCCCC CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(17:17)=';'
CCCCC NCSTR=17
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NCSTR.LE.65)GOTO2209
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=2
      GOTO2219
2209  CONTINUE
      IF(I.EQ.2)GOTO2219
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
2219  CONTINUE
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
 2220 CONTINUE
C
      IF(NCSTR.LE.2)GOTO2290
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2290 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-12, 10-13.                          **
C               **********************************************************
C
CCCCC JULY, 1990.  PACK COORDINATES (AT REQUEST OF MIKE KELLY TO SPEED HIS
CCCCC EMULATOR PACKAGE).   NOTE THAT WHEN THE COORDINATES ARE PACKED, SOME
CCCCC CODES DO NOT NEED TO BE REPEATED.
 2300 CONTINUE
      IF(NP.LE.0)GOTO2390
C
      I=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pa'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(16:16)='Z'
CCCCC NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(NP.LE.1)GOTO2390
      DO2320I=2,NP
C
      IF(NCSTR.LE.112)GOTO2309
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='Z'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*p'
      NCSTR=3
 2309 CONTINUE
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:4)='*pb'
CCCCC NCSTR=4
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(10:10)=','
CCCCC NCSTR=10
CCCCC CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(16:16)='Z'
CCCCC NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='b'
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
C
 2320 CONTINUE
      IF(NCSTR.LE.3)GOTO2390
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='Z'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2390 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE HEWLETT-PACKARD PCL LANDSCAPE CASE    **
C               **  (HP LASER PRINTERS, E.G. LASER JET              **
C               **  USE BRESENHAM ALGORITHIM TO DRAW THE LINE       **
C               **  THE ROUTINE HPBRES IS USED TO DRAW THE LINE     **
C               **  SEGMENTS BETWEEN TWO POINTS.                    **
C               ******************************************************
C
 2600 CONTINUE
      IF(NP.LE.1)GOTO2690
C
      IWIDTH=INT(PTHIC2)
      DO2620I=1,NP-1
C
      PYTEMP=100.-PY(I)
      CALL GRTRSD(PX(I),PYTEMP,IXSTRT,IYSTRT,ISUBN0)
      J=I+1
      PYTEMP=100.-PY(J)
      CALL GRTRSD(PX(J),PYTEMP,IXSTOP,IYSTOP,ISUBN0)
      CALL HPBRES(IXSTRT,IYSTRT,IXSTOP,IYSTOP,ICOL,IWIDTH)
C
 2620 CONTINUE
C
 2690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      IF(NP.LE.0)GOTO3190
      I=1
CCCCC WRITE(IGUNIT,3111)PX(I),PY(I)
C3111 FORMAT('MOVE TO ',F10.5,2X,F10.5)
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.1)GOTO3190
      DO3120I=2,NP
CCCCC WRITE(IGUNIT,3121)PX(I),PY(I)
C3121 FORMAT('DRAW TO ',F10.5,2X,F10.5)
      ICSTR(1:8)='DRAW TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3120 CONTINUE
 3190 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
C  MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIV POINTS IF THEY
C  ARE IDENTICAL.
C
 3200 CONTINUE
      IF(NP.LE.0)GOTO3290
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
C
      I=1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.1)GOTO3290
      DO3220I=2,NP
      ICSTR(1:5)='DRTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3220 CONTINUE
      GOTO3290
C
 3250 CONTINUE
      I=1
      ICSTR(1:2)='M '
      NCSTR=2
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      IPXTMP=INT(AX*10.**IGENFA+0.5)
      IPYTMP=INT(AY*10.**IGENFA+0.5)
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IPXOLD=IPXTMP
      IPYOLD=IPYTMP
C
      IF(NP.LE.1)GOTO3290
      DO3270I=2,NP
C
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      IPXTMP=INT(AX*10.**IGENFA+0.5)
      IPYTMP=INT(AY*10.**IGENFA+0.5)
      IF(I.GT.2.AND.IPXTMP.EQ.IPXOLD.AND.IPYTMP.EQ.IPYOLD)GOTO3270
      IPXOLD=IPXTMP
      IPYOLD=IPYTMP
C
      ICSTR(1:2)='D '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3270 CONTINUE
C
 3290 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3300 CONTINUE
      IF(NP.LE.0)GOTO3390
C
      I=1
      ICSTR(1:6)='LINE '
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:28)=','
      IF(NP.LE.1)ICSTR(28:28)=';'
      NCSTR=28
C
      IF(NP.LE.1)GOTO3390
      DO3320I=2,NP
C
      IF(NCSTR.LE.55)GOTO3325
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=0
C
 3325 CONTINUE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      IF(I.EQ.NP)ICSTR(NCSTR:NCSTR)=';'
 3320 CONTINUE
      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3390 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO DRAW A POLYLINE--                            **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  REFERENCE--CALCOMP LIBRARY                      **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRDRPL TO DRAW POLYLINE CALCOMP DEV.')
CCCCC ICSTR(1:51)='FIX SUBROUTINE GRDRPL TO DRAW POLYLINE CALCOMP DEV.'
CCCCC NCSTR=51
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.0)GOTO4190
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      I=1
C
      IPEN=3
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
C
      IF(NP.LE.1)GOTO4190
      DO4120I=2,NP
      IPEN=2
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
 4120 CONTINUE
 4190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(NP.LE.0)GOTO4690
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      I=1
C
      IPEN=3
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
C
      IF(NP.LE.1)GOTO4690
      DO4620I=2,NP
      IPEN=2
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
 4620 CONTINUE
 4690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(NP.LE.0)GOTO4790
      IF(JPATT.EQ.0)GOTO4790
      I=1
C
CCCCC PYTEMP=100.0-PY(I)
      PYTEMP=PY(I)
      CALL GRTRSD(PX(I),PYTEMP,IX,IY,ISUBN0)
CQWVF CALL MOVETO(INT2(IX),INT2(IY),WXY)
C
      DO4720I=2,NP
CCCCC PYTEMP=100.0-PY(I)
      PYTEMP=PY(I)
      CALL GRTRSD(PX(I),PYTEMP,IX,IY,ISUBN0)
CQWVF ISTATUS=LINETO(INT2(IX),INT2(IY))
 4720 CONTINUE
C
 4790 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(NP.LE.1)GOTO9000
      IF(JPATT.EQ.-1)GOTO9000
C
      DO4810I=1,NP
        PXP(I)=PX(I)
        PYP(I)=PY(I)
 4810 CONTINUE
      CALL GLDRAW(PXP,PYP,NP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      IF(NP.LE.0)GOTO4940
      IF(JPATT.EQ.0)GOTO4940
      I=1
C
      PYTEMP=PY(I)
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CINTE CALL IGrMoveTo(REAL(IX),REAL(IY))
C
      DO4920I=2,NP
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CINTE CALL IGrLineTo(REAL(IX),REAL(IY))
 4920 CONTINUE
C
 4940 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49b-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(NP.LE.0)GOTO4990
      IF(JPATT.EQ.0)GOTO4990
      I=1
C
      PYTEMP=PY(I)
CWINT CALL IGrMoveTo(PX(I),PY(I))
C
      DO4970I=2,NP
CWINT CALL IGrLineTo(PX(I),PY(I))
 4970 CONTINUE
C
 4990 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO DRAW A POLYLINE--                            **
C               **  WRITE OUT    ZZZZZZZZZZ                         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE THE CALCOMP LIBRARY ROUTINES                **
C               **  PLOT USED TO DRAW LINES                         **
C               **  VALUE OF IPEN DETERMINES DASH PATTERN           **
C               **  REFERENCE: FUNDAMENTAL PLOTTING SUBROUTINES,    **
C               **             FORTRAN, NICOLET-ZETA, 1984          **
C               **  PAGES: 2-2, 3-8, 3-9                            **
C               ******************************************************
C
 5100 CONTINUE
CCCCC IF(NP.LE.0)GOTO5190
CCCCC I=1
CCCCC ICSTR(1:1)='1'
CCCCC NCSTR=1
CCCCC CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC IF(NP.LE.1)GOTO5190
CCCCC DO5120I=2,NP
CCCCC ICSTR(1:1)='2'
CCCCC NCSTR=1
CCCCC CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C5120 CONTINUE
C5190 CONTINUE
      IF(NP.LE.0)GOTO5190
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      I=1
C
      IPEN=3
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
C
      IF(NP.LE.1)GOTO5190
      IPEN=2
      IF(JPATT.GT.0)IPEN=13+JPATT
      IF(IPEN.NE.2 .AND. (IPEN.LT.14.OR.IPEN.GT.19))IPEN=2
      DO5120I=2,NP
      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
      CALL PLOT(AX,AY,IPEN)
 5120 CONTINUE
 5190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO DRAW A POLYLINE--                            **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRDRPL TO DRAW POLYLINE RAMTEK DEVICE')
      ICSTR(1:52)='FIX SUBROUTINE GRDRPL TO DRAW POLYLINE RAMTEK DEVICE'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
C  SEPTEMBER, 1990.  ONLY PLOT 1,000 POINTS AT A TIME.
C  GOT AN ERROR MESSAGE ("TOO MANY POINTS") WHEN TRIED TO DO MORE.
C
 6600 CONTINUE
      IF (NP.EQ.1)GOTO 9000
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      NLOOPS=(NP-1)/1000+1
      DO 6605 K=1,NLOOPS
        ISTRT=(K-1)*1000+1
        ILAST=K*1000+1
        IF(ILAST.GT.NP)ILAST=NP
        IF(ILAST.LE.ISTRT)ISTRT=ISTRT-1
        JCOUNT=0
        DO 6610 IDUMMY=ISTRT,ILAST
          JCOUNT=JCOUNT+1
          I = IDUMMY
          CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
          IPX(JCOUNT) = IX
          IPY(JCOUNT) = IY
 6610   CONTINUE
CSUN    CALL cfpolyline(IPX,IPY,JCOUNT)
 6605 CONTINUE
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO DRAW A POLYLINE--                            **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRDRPL TO DRAW POLYLINE XXXXXX DEVICE')
      ICSTR(1:52)='FIX SUBROUTINE GRDRPL TO DRAW POLYLINE XXXXXX DEVICE'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO DRAW A POLYLINE--                            **
C               **  USE THE P[  (= POSITION) INSTRUCTION            **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  AND THE V[ (= VECTOR) INSTRUCTION               **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  WITH   TRAILING ]                               **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 106 AND 100                    **
C               ******************************************************
C
C  MARCH, 1991.  PACK REGIS OUTPUT.
 8100 CONTINUE
      NCSTR=0
      IF(NP.LE.0)GOTO8190
C
      MAXREG=130
      I=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      ICSTR(1:2)='P['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      ICSTR(15:17)='V[]'
      NCSTR=17
C
      IF(NP.LE.1)GOTO8190
      DO8120I=2,NP
C
      IF(NCSTR.GT.MAXREG-15)THEN
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=0
      END IF
C
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)='V['
      NCSTR=NCSTR2
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=']'
C
 8120 CONTINUE
C
 8190 CONTINUE
      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **    NEW PATH                                      **
C               **    XCOOR YCOOR MOVETO                            **
C               **    %LOOP                                         **
C               **    XCOOR YCOOR LINETO                            **
C               **    %END LOOP                                     **
C               **    STROKE                                        **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **             COOKBOOK, ADOBE SYSTEMS              **
C               ******************************************************
C
CCCCC JUNE, 1990.  IF "BLANK" LINE PATTERN, THEN SKIP.
 8600 CONTINUE
      IF(NP.LE.0)GOTO8690
      IF(JPATT.EQ.0)GOTO8690
      I=1
C
      ICSTR(1:8)='newpath '
      NCSTR=8
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:22)=' m '
      NCSTR=22
      IF(NP.LE.1)GOTO8650
C
CCCCC FOLLOWING LINE ADDED AUGUST, 1990.
      MAXPSP=200
      DO8620I=2,NP
CCCCC FOLLOWING LINES ADDED AUGUST 1990.
CCCCC SOME POSTSCRIPT PRINTERS SEEMED TO CHOKE IF TOO MANY LINES DRAWN
CCCCC ON SAME PATH, SO SET AN UPPER LIMIT.
      IF(MOD(I,MAXPSP).NE.0)GOTO8622
      IF(NCSTR.LE.110)GOTO8623
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=0
 8623 CONTINUE
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+14
      ICSTR(NCSTR:NCSTR2)='stroke newpath '
      NCSTR=NCSTR2
      IPREV=I-1
      CALL GRTRSD(PX(IPREV),PY(IPREV),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+2
      ICSTR(NCSTR:NCSTR2)=' m '
      NCSTR=NCSTR2
 8622 CONTINUE
CCCCC END AUGUST, 1990 CHANGE.
      IF(NCSTR.LE.110)GOTO8625
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=0
C
 8625 CONTINUE
C
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+2
      ICSTR(NCSTR:NCSTR2)=' l '
      NCSTR=NCSTR2
 8620 CONTINUE
C
 8650 CONTINUE
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+5
      ICSTR(NCSTR:NCSTR2)='stroke'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC LANDSCAPE CASE                   **
C               **  <ICARAT>IGV       - ENABLE VECTOR GRAPHICS MODE **
C               **  <ICARAT>Wtttttbbbbblllllrrrrr - SET PAGE MARGINS**
C               **  NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER*
C               **        OF PICTURE POINTS.  WE ONLY WANT TO CLIP  **
C               **        AT THE MARGIN, NOT FORCE A PAGE ERASE.    **
C               **  <ICARAT>Tttttt    - SET Y ORGIN FROM TOP OF PAGE**
C               **  <ICARAT>Jjjjjj    - SET X ORGIN FROM LEFT       **
C               **  <ICARAT>PWnn      - SET PEN WIDTH (3 CLOSEST TO **
C               **                      0.1 DATAPLOT UNITS)         **
C               **  <ICARAT>Vp        - SELECT LINE PATTERN         **
C               **  <ICARAT>UXXXXX:YYYYY - MOVE                     **
C               **  <ICARAT>DXXXXX:YYYYY - DRAW                     **
C               **  REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER 14 **
C               **          ON VECTOR GRAPHICS                      **
C               ******************************************************
C
 9100 CONTINUE
      IF(NP.LE.0)GOTO9190
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      I=1
C
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:4)='IGV'
      ICSTR(5:5)=ICARAT
      ICSTR(6:6)='W'
C
      IF(IORNSW.EQ.'PORT')GOTO9110
CCCCC AXLEFT=IQUILM
CCCCC AXRGHT=11.*QUIPPI-IQUIRM
CCCCC AYTOP=IQUITM
CCCCC AYBOT=8.5*QUIPPI-IQUIBM
CCCCC AFACTH=11.*QUIPPI
CCCCC AFACTV=8.5*QUIPPI
      IX2=11000
      IY2=8500
      GOTO9120
C
 9110 CONTINUE
C
CCCCC AXLEFT=IQU2LM
CCCCC AXRGHT=8.5*QUIPPI-IQU2RM
CCCCC AYTOP=IQU2TM
CCCCC AYBOT=11.*QUIPPI-IQU2BM
CCCCC AFACTH=8.5*QUIPPI
CCCCC AFACTV=11.*QUIPPI
      IX2=8500
      IY2=11000
C
 9120 CONTINUE
C
CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5)
CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5)
CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5)
CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5)
      IX=0
      IY=0
      NCSTR=6
      NCHTOT=-5
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(27:27)=ICARAT
      ICSTR(28:33)='T00000'
      ICSTR(34:34)=ICARAT
      ICSTR(35:40)='J00000'
      ICSTR(41:41)=ICARAT
      ICSTR(42:43)='PW'
      NCSTR=43
      NCHTOT=-2
      IJUNK=INT(PTHIC2+0.5)
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      NCSTR=45
      ICSTR(46:46)=ICARAT
      ICSTR(47:47)='V'
      NCSTR=47
      NCHTOT=-1
      CALL GRTRIN(JPATT,NCHTOT,ICSTR,NCSTR)
      ICSTR(49:49)=ICARAT
      ICSTR(50:50)='U'
      NCSTR=50
C     NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y
      PYTEMP=100.-PY(I)
      CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0)
      NCHTOT=-5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(56:56)=':'
      NCSTR=56
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.1)GOTO9190
C
      NCSTR=0
      NCHTOT=-5
      DO9130I=2,NP
C
      IF(NCSTR.LT.110)GOTO9140
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=0
 9140 CONTINUE
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICARAT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='D'
      PYTEMP=100.-PY(I)
      CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=':'
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
 9130 CONTINUE
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICARAT
      NCTMP1=NCSTR+1
      NCSTR=NCSTR+3
      ICSTR(NCTMP1:NCSTR)='IGE'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9000
      IF(NP.EQ.1)GOTO9000
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
      DO9610IDUMMY=1,NP
         I = IDUMMY
         CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
         IPX(IDUMMY) = IX
         IPY(IDUMMY) = IY
 9610 CONTINUE
      CALL XDRAW(IPX,IPY,NP)
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 69.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 98.                        **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 32-33.      **
C               *************************************************
C
10000 CONTINUE
      IF(ITCST.EQ.'CLOS')GOTO9000
      IF(NP.EQ.1)GOTO9000
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
      IF(JPATT.EQ.-1)GOTO9000
CCCCC THE FOLLOWING LOOP WAS ADDED   SEPTEMBER 1995
      DO10100I=1,NP
         PX1P=PX(I)
         PY1P=PY(I)
         CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
         PXP(I)=AX
         PYP(I)=AY
10100 CONTINUE
      CALL TCDRPL(PXP,PYP,NP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      IF(JPATT.EQ.-1)GOTO9000
CGKS  CALL GPL(NP, PS, PY)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      IF(NP.LE.1)GOTO9000
      IF(JPATT.EQ.-1)GOTO9000
C
      DO12010I=2,NP
        CALL GRTRSD(PX(I-1),PY(I-1),IX1,IY1,ISUBN0)
        CALL GRTRSD(PX(I),PY(I),IX2,IY2,ISUBN0)
        CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT)
12010 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      IF(NP.LE.1)GOTO9000
      IF(JPATT.EQ.-1)GOTO9000
C
CMACI CALL MovePen(PX(1),PY(1))
      DO13010I=2,NP
CMACI   CALL MoveDraw(PX(I),PY(I))
13010 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      IF(NP.LE.1)GOTO9000
      IF(JPATT.EQ.-1)GOTO9000
C
      DO13510I=1,NP
        CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
        PXP(I)=REAL(IX1)
        PYP(I)=REAL(IY1)
13510 CONTINUE
CAQUA CALL aqtAddPolylineTo(PXP,PYP,NP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      IF(NP.LE.1)GOTO9000
      IF(JPATT.EQ.-1)THEN
        GOTO9000
      ELSEIF(JPATT.EQ.1)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:13)='drawline[ 0]'
        NCSTR=13
      ELSEIF(JPATT.EQ.3)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:15)='dottedline{12}'
        NCSTR=15
      ELSEIF(JPATT.EQ.2)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:13)='dashline{24}'
        NCSTR=13
      ELSEIF(JPATT.EQ.4)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:18)='dashline[-30]{12}'
        NCSTR=18
      ELSEIF(JPATT.EQ.5)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:18)='dashline[-30]{24}'
        NCSTR=18
      ELSEIF(JPATT.EQ.6)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:18)='dashline[+30]{12}'
        NCSTR=18
      ELSEIF(JPATT.EQ.7)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:18)='dashline[+30]{24}'
        NCSTR=18
      ELSE
        ICSTR(1:1)=IBASLC
        ICSTR(2:13)='drawline[ 0]'
        NCSTR=13
      ENDIF
C
      IPTS=0
      NCHTOT=5
      DO15010I=1,NP
        IPTS=IPTS+1
        CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='('
        CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=')'
        IF(NCSTR.GT.80)THEN
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          NCSTR=0
          IF(JPATT.EQ.1)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:13)='drawline[ 0]'
            NCSTR=13
          ELSEIF(JPATT.EQ.3)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:15)='dottedline{12}'
            NCSTR=15
          ELSEIF(JPATT.EQ.2)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:13)='dashline{24}'
            NCSTR=13
          ELSEIF(JPATT.EQ.4)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:18)='dashline[-30]{12}'
            NCSTR=18
          ELSEIF(JPATT.EQ.5)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:18)='dashline[-30]{24}'
            NCSTR=18
          ELSEIF(JPATT.EQ.6)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:18)='dashline[+30]{12}'
            NCSTR=18
          ELSEIF(JPATT.EQ.7)THEN
            ICSTR(1:1)=IBASLC
            ICSTR(2:18)='dashline[+30]{24}'
            NCSTR=18
          ELSE
            ICSTR(1:1)=IBASLC
            ICSTR(2:13)='drawline[ 0]'
            NCSTR=13
          ENDIF
          IPTS=0
          IPTS=IPTS+1
          CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='('
          CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=','
          CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=')'
        ENDIF
15010 CONTINUE
      IF(IPTS.GE.2)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      IF(NP.LE.0)GOTO16090
      IF(JPATT.LE.0)GOTO16090
      CALL DPCONA(34,IQUOTE)
C
      ICSTR(1:12)='   <polyline'
      NCSTR=-12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(ISVGSS(1:3).EQ.'EXT')THEN
        NCSTR=12
        ICSTR(1:NCSTR)='      class='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
C
        JTEMP=INT(PTHIC2+0.5)
        IF(JTEMP.LE.1)THEN
          ICSTR(NCSTR:NCSTR+6)='narrow-'
          NCSTR=NCSTR+7
        ELSEIF(JTEMP.GE.2 .AND. JTEMP.LE.3)THEN
          ICSTR(NCSTR:NCSTR+6)='medium-'
          NCSTR=NCSTR+7
        ELSEIF(JTEMP.GE.4 .AND. JTEMP.LE.5)THEN
          ICSTR(NCSTR:NCSTR+4)='wide-'
          NCSTR=NCSTR+5
        ELSE
          ICSTR(NCSTR:NCSTR+9)='extrawide-'
          NCSTR=NCSTR+10
        ENDIF
        IF(JPATT.EQ.1)THEN
          ICSTR(NCSTR:NCSTR+4)='solid'
          NCSTR=NCSTR+5
        ELSEIF(JPATT.EQ.2)THEN
          ICSTR(NCSTR:NCSTR+3)='dash'
          NCSTR=NCSTR+4
        ELSEIF(JPATT.EQ.3)THEN
          ICSTR(NCSTR:NCSTR+5)='dotted'
          NCSTR=NCSTR+6
        ELSEIF(JPATT.EQ.4)THEN
          ICSTR(NCSTR:NCSTR+4)='dash2'
          NCSTR=NCSTR+5
        ELSEIF(JPATT.EQ.5)THEN
          ICSTR(NCSTR:NCSTR+4)='dash3'
          NCSTR=NCSTR+5
        ELSEIF(JPATT.EQ.6)THEN
          ICSTR(NCSTR:NCSTR+4)='dash4'
          NCSTR=NCSTR+5
        ELSEIF(JPATT.EQ.7)THEN
          ICSTR(NCSTR:NCSTR+4)='dash5'
          NCSTR=NCSTR+5
        ELSE
          ICSTR(NCSTR:NCSTR+4)='solid'
          NCSTR=NCSTR+5
        ENDIF
C
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        CALL GRTRCO('FORE',ISVGFC,JCOL2)
        IF(JCOL2.NE.JCOL)THEN
          ICSTR(1:12)='      style='
          ICSTR(13:13)=IQUOTE
          NCSTR=-13
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:21)='             stroke:#'
          NCSTR=21
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+2
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:13)='             '
          ICSTR(14:14)=IQUOTE
          NCSTR=-14
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
C
      ELSE
C
        ICSTR(1:12)='      style='
        ICSTR(13:13)=IQUOTE
        NCSTR=-13
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:26)='             stroke-width:'
        NCSTR=26
        JTEMP=INT(PTHIC2+0.5)
        IF(JTEMP.LT.1)JTEMP=1
        IF(JTEMP.GT.50)JTEMP=50
        NCHTOT=1
        IF(JTEMP.GE.10)NCHTOT=2
        CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(ISVGCA.EQ.'ROUN')THEN
          NCSTR=35
          ICSTR(1:NCSTR)='             stroke-linecap: round;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGCA.EQ.'SQUA')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linecap: square;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGCA.EQ.'BUTT')THEN
          NCSTR=34
          ICSTR(1:NCSTR)='             stroke-linecap: butt;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          CONTINUE
        ENDIF
C
        IF(ISVGJS.EQ.'ROUN')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: round;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGJS.EQ.'BEVE')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: bevel;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(ISVGJS.EQ.'MITE')THEN
          NCSTR=36
          ICSTR(1:NCSTR)='             stroke-linejoin: miter;'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          CONTINUE
        ENDIF
C
        ICSTR(1:21)='             stroke:#'
        NCSTR=21
        NCHTOT=2
        JTEMP=JCOL
        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+2
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(JPATT.GE.2 .AND. JPATT.LE.8)THEN
          NCHTOT=3
          NCSTR=31
          ICSTR(1:NCSTR)='             stroke-dasharray: '
          IF(JPATT.EQ.2)THEN
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.3)THEN
            JTEMP=1
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=1
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.4)THEN
            JTEMP=9
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.5)THEN
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=9
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=2
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.6)THEN
            JTEMP=9
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=9
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.7)THEN
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=1
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=3
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=1
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ELSEIF(JPATT.EQ.8)THEN
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=2
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=5
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
            NCSTR=NCSTR+1
            ICSTR(NCSTR:NCSTR)=','
            JTEMP=2
            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
          ENDIF
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
C
        ICSTR(1:22)='             fill:none'
        NCSTR=22
        NCSTR=-22
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:13)='             '
        ICSTR(14:14)=IQUOTE
        NCSTR=-14
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      END IF
C
      ICSTR(1:13)='      points='
      ICSTR(14:14)=IQUOTE
      NCSTR=-14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      NCSTR=3
      ICSTR(1:NCSTR)='   ' 
      I=1
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IF(NP.LE.1)GOTO16050
C
      DO16020I=2,NP
        IF(NCSTR.GT.110)THEN
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          NCSTR=3
          ICSTR(1:NCSTR)='   '
        ENDIF
        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        IF(NCSTR.LE.110)GOTO16020
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=3
        ICSTR(1:NCSTR)='   '
16020 CONTINUE
C
16050 CONTINUE
      IF(NCSTR.GT.3)THEN
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
C
      ICSTR(1:3)='   '
      ICSTR(4:4)=IQUOTE
      ICSTR(5:6)='/>'
      NCSTR=-6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
16090 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRDRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IGUNIT
 9012 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,MAX(10,NP)
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9018)IFIG
 9018 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
 9020 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL,JCOL
 9021 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IMODEL
 9022 FORMAT('IMODEL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)PTHICK,NLOOP,AI,DEL
 9023 FORMAT('PTHICK,NLOOP,AI,DEL = ',E15.7,I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)NCSTR
 9033 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9037
      DO9035I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9036)I,ICSTR(I:I),IASCNE
 9036 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9037 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRERSC(JCOL,ICOLT)
C
C     PURPOSE--ERASE THE SCREEN
C              OF A SPECIFIC GRAPHICS DEVICE,
C              AND (IF A COLOR DEVICE) FLOOD THE SCREEN
C              WITH THE PRE-SCRIBED BACKGROUND COLOR.
C     NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     NOTE--WE UTILIZE EXTERNAL LIBRARIES FOR MANY GRAPHICS DEVICES.
C           MANY OF THESE ARE COMMENTED OUT.  TO ACTIVATE ONE OF THESE,
C           YOU NEED TO DO A GLOBAL CHANGE, USING ANY ASCII EDITOR,
C           OF LINES THAT START WITH "CXXXX" WHERE XXXX IS REPLACED
C           THE DEVICE SYMBOL (E.G., QWIN FOR THE QUICK-WIN DRIVER
C           ON THE PC).  WE RECOMMEND YOU SAVE AN ORIGINAL VERSION
C           OF THE FILE IN CASE YOU NEED TO DEACTIVATE THAT PARTICULAR
C           DRIVER AT A LATER DATE.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1990. ADD AF COMMAND TO HP-GL (BY ALAN)
C     UPDATED         --JULY     1990. BACKGROUND COLOR FOR SOME HP 2622 (ALAN)
C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN)
C     UPDATED         --JANUARY  1991. ADD COLOR SUPPORT TO REGIS (ALAN)
C     UPDATED         --MAY      1991. 3 ISUBNO TO ISUBN0 (JJF)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --MAY      1991. FIX 4027
C     UPDATED         --OCTOBER  1991. POSTSCRIPT FONTS TABLE DRIVEN (ALAN)
C     UPDATED         --MAY      1992. AVOID POSTSCRIPT BLANK PAGE
C     UPDATED         --MAY      1992. DEBUG STATEMENTS
C     UPDATED         --AUGUST   1992. SET BACKGROUND FOR CGM (ALAN)
C                                      HP-GL FOR LASERJET III
C     UPDATED         --JANUARY  1993. POSTSCRIPT PAGE NUMBER (ALAN)
C     UPDATED         --JANUARY  1993. POSTSCRIPT "%%" LINES (ALAN)
C     UPDATED         --OCTOBER  1993. POSTSCRIPT SET BACKGROUND (ALAN)
C     UPDATED         --MAY      1996. MINOR FIX TO X11
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      (OLD CALCOMP STYLE)
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --FEBRUARY 1997. BUG FIX FOR QWIN
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --JANUARY  2003. SOME POSTSCRIPT FIXES
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*4 ICOLT
      CHARACTER*1 IQUOTE
      CHARACTER*1 ICARAT
      CHARACTER*2 ICJUNK
C  AUGUST 1992.  ADD FOLLOWING LINE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C  OCTOBER 1993.  ADD FOLLOWING LINE
      DIMENSION PX(5)
      DIMENSION PY(5)
C  JULY 1996.  ADD FOLLOWING SECTION.
      INTEGER ILAHEY(9)
      REAL RLAHEY(8)
      CHARACTER*40 CLAHEY
C  FEBRUARY 2001.  ADD FOLLOWING SECTION FOR JPEG, PNG DRIVER.
      INTEGER IADE(81)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
CCCCC THE FOLLOWING LINE WAS ADDED    MAY 1992 (JJF)
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 IPSTNW
      COMMON/IPSTNW/IPSTNW
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XCLEAR, XCHECK, XERASE, XUPDAT
C  AUGUST 1992.  DEFINE RGB COLORS FOR CGM
C
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='ERSC'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      ICHAPS=0
      INULLI=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ERSC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRERSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)JCOL
   52 FORMAT('JCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGBAUD,AGERDE
   53 FORMAT('IGBAUD,AGERDE = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1992
      WRITE(ICOUT,54)IPL2CS,IPSTBP,IPSTPN
   54 FORMAT('IPL2CS,IPSTBP, IPSTPN = ',A4,1X,A4,1X,I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IMANUF,IMODEL
   55 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IGUNIT
   56 FORMAT('IGUNIT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO9000
C
      IF(IMODEL.EQ.'4020')GOTO1200
      IF(IMODEL.EQ.'4022')GOTO1200
      IF(IMODEL.EQ.'4025')GOTO1200
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ************************************************************
C               **  STEP 11--                                             **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
C               **  TO ERASE THE SCREEN,                                  **
C               **  WRITE OUT AN ESCAPE FORM-FEED                         **
C               ************************************************************
C
 1100 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC,IFFC
C1111 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IFFC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      DO1130J=1,10
      ICSTR(J:J)=INULC
 1130 CONTINUE
      NCSTR=10
C
CCCCC ICHAPS=IGBAUD/10
CCCCC INULLI=ICHAPS/10
      INULLI=AGERDE+0.5
      IF(INULLI.LE.0)GOTO1139
      DO1135I=1,INULLI
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1135 CONTINUE
 1139 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
C               **  (NON-COLOR RASTER DEVICES).                     **
C               **  TO ERASE THE SCREEN,                            **
C               **  USE THE !ERA COMMAND                            **
C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE 5-6.    **
C               ******************************************************
C
 1200 CONTINUE
CCCCC 4 LINES WERE FIXED IN THIS SECTION  MAY 1991 (ALAN)
CCCCC WRITE(IGUNIT,1211)JCOL
C1211 FORMAT('!ERA G C',I1,';')
CCCCC ICSTR(1:8)='!ERA G C;'
      ICSTR(1:9)='!ERA G C;'
      IX=JCOL+48
CCCCC ICSTR(9:9)=CHAR(IX)
CCCCC CALL DPCONA(IX,ICSTR(9:9))
      CALL DPCONA(IX,ICSTR(10:10))
CCCCC ICSTR(10:10)=';'
      ICSTR(11:11)=';'
CCCCC NCSTR=10
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE 4105 CASE                             **
C               **  (COLOR DEVICE)                                  **
C               **  TO ERASE THE SCREEN,                            **
C               **  SET THE BACKGROUND COLOR AND                    **
C               **  THEN CARRY OUT THE ERASE                        **
C               **  REFERENCE--PAGE 5-51                            **
C               ******************************************************
C
 1300 CONTINUE
CCCCC WRITE(IGUNIT,1311)IESCC,JCOL
C1311 FORMAT(A1,'RA1',I1,'0')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='RA1'
      IX=JCOL+48
CCCCC ICSTR(5:5)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(5:5))
      ICSTR(6:6)='0'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1312)IESCC,IFFC
C1312 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IFFC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
C  MAY, 1990.  ADD AN "ADVANCE PAGE" COMMAND.  HOWEVER, DO NOT SEND ON FIRST
C  PLOT.
C
C  AUGUST, 1992.  HANDLE LASER JET III CASE SEPARATELY.  TO ADVANCE
C  PAGE, NEED TO EXIT BACK INTO LASER JET MODE.
 2200 CONTINUE
      IF(IMODE3.EQ.'LJET')GOTO2220
      IF(IHPGSW.EQ.'ON')GOTO2210
C
      IHPGSW='ON'
      GOTO9000
C
 2210 CONTINUE
      ICSTR(1:3)='AF;'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
 2220 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:2)='E'
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(2:4)='%0B'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:3)='IN;'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:4)='RO90'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-4, 10-3.                         **
C               **********************************************************
C
C  JULY, 1990.  SET BACKGROUND COLOR FOR 2622 TYPE DEVICES THAT SUPPORT COLOR
C
 2300 CONTINUE
      NCSTR=1
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:5)='*daZ'
CCCCC NCSTR=5
      ICSTR(NCSTR:NCSTR)=IESCC
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+3
      ICSTR(NCSTR:NCSTR2)='*daZ'
      NCSTR=NCSTR2
      IF(IGCOLO.NE.'ON')GOTO2310
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IESCC
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)='*e'
      NCSTR=NCSTR2
      NCHTOT=1
      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='B'
 2310 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  TO PRINT THE CURRENT PAGE--                         **
C               **     ESCC &l0H                                        **
C               **  REFERENCE--LASERJET SERIES II TECHNICAL             **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 5-2                                 **
C               **********************************************************
C
 2600 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='&l0H'
      NCSTR=5
CCCCC THE FOLLOWING LINE WAS FIXED    MAY 1991
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBNO)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('ERASE SCREEN')
C  DECEMBER 1987: FOR METAFILE, GIVE BACKGROUND COLOR
      ICSTR(1:21)='SET COLOR BACKGROUND '
      ICSTR(22:25)=ICOLT(1:4)
      NCSTR=25
CCCCC THE FOLLOWING LINE WAS FIXED    MAY 1991
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBNO)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='ERASE SCREEN'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
CCCCC THE FOLLOWING 3 LINES WERE FIXED    MAY 1991  (JJF)
CCCCC ICSTR(1:16)='SECO BACKGROUND '
CCCCC ICSTR(17:20)=ICOLT(1:4)
CCCCC NCSTR=20
      ICSTR(1:10)='SECO BACK '
      ICSTR(11:14)=ICOLT(1:4)
      NCSTR=14
CCCCC THE FOLLOWING LINE WAS FIXED    MAY 1991  (JJF)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBNO)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:4)='ERSC'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  1) IF A PICTURE IS CURRENTLY ACTIVE, CLOSE IT            **
C               **  2) ACTIVATE A NEW PICTURE                                **
C               ***************************************************************
C
 3300 CONTINUE
C
      IF(ICGMSW.EQ.'OFF')GOTO3310
C
      ICSTR(1:7)='ENDPIC;'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3310 CONTINUE
C
      CALL DPCONA(39,IQUOTE)
      ICSTR(1:7)='BEGPIC '
      ICSTR(8:8)=IQUOTE
      ICSTR(9:9)=' '
      ICSTR(10:10)=IQUOTE
      ICSTR(11:11)=';'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICGMSW='ON'
C NOTE:  BACKGROUND COLOR SHOULD SPECIFY RGB COMPONENTS (EVEN IF
C        COLOR MODE IS INDEXED OTHERWISE), SO LEAVE OFF.  LET POST
C        PROCESSOR SET THE BACKGROUND COLOR.  MAYBE AT FUTURE TIME
C        CAN ADD OPTION TO TRANSLATE DATAPLOT COLORS TO RGB COMPONENTS.
CCCCC ICSTR(1:10)='BACKCLR 0;'
CCCCC NCSTR=10
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='BEGPICBODY;'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  AUGUST 1992.  SPECIFY BACKGROUND COLOR AS RGB VALUES.
C
      ICSTR(1:9)='BACKCOLR '
      NCSTR=9
      NCHTOT=3
      IVAL=IRED(JCOL)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IVAL=IGREEN(JCOL)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IVAL=IBLUE(JCOL)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               *******************************************************
C               **  STEP 34--                                        **
C               **  TREAT THE CGM (BINARY) GENERAL CASE              **
C               **  1) IF A PICTURE IS CURRENTLY ACTIVE, CLOSE IT    **
C               **  2) ACTIVATE A NEW PICTURE                        **
C               *******************************************************
C
 3400 CONTINUE
C
      IF(ICGMSW.EQ.'OFF')GOTO3410
C
 3410 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO ERASE SCREEN---                              **
C               **  USE CALCOMP LIBRARY                             **
C               **  GRINDE DOES INITIAL PAGE ERASE, CHECK FOR THIS  **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRERSC TO ERASE CALCOMP DEVICE')
CCCCC ICSTR(1:45)='FIX SUBROUTINE GRERSC TO ERASE CALCOMP DEVICE'
CCCCC NCSTR=45
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICALSW.EQ.'ON')GOTO4190
      IPEN=-3
      YNEW=0.
      DOTPPI=1000.
      XPAGE=ANUMHP/DOTPPI
      XNEW=XPAGE+1.
      CALL PLOT(XNEW,YNEW,IPEN)
 4190 CONTINUE
      ICALSW='OFF'
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(ILAHSW.EQ.'OFF')THEN
        IX1=0
        IF(ILAHGR.EQ.'BIOS')THEN
          IX2=0
        ELSEIF(ILAHGR.EQ.'DIRE')THEN
          IX2=1
        ELSE
          IX2=1
        ENDIF
        IMODE=0
        CALL PLOTS(IX1,IX2,IMODE)
        ILAHSW='ON'
      ELSE
        AX=0.0
        AY=0.0
        IPEN=-999
        CALL PLOT(AX,AY,IPEN)
      ENDIF
      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
      ILAHNC=ILAHEY(4)
      ANUMHP=REAL(ILAHEY(1))
      ANUMVP=REAL(ILAHEY(2))
CCCCC FILL A RECTANGLE WITH THE COLOR
      PX(1)=0.0
      PX(2)=11.0
      PX(3)=11.0
      PX(4)=0.0
      PX(5)=0.0
      PY(1)=0.0
      PY(2)=0.0
      PY(3)=8.5
      PY(4)=8.5
      PY(5)=0.0
      NP=5
      CALL NEWPEN(JCOL)
      CALL FILL(NP,PX,PY)
      ILAHCC=JCOL
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
C
CCCCC FEBRUARY 1995.  BE SURE TO SET FOCUS TO GRAPHICS SCREEN!
CQWVF ISTATS=FOCUSQQ(99)
      IF(IQWNCL.EQ.'VGA')THEN
CQWVF   ISTATS=SETBKCOLOR(JCOL)
      ELSEIF(IQWNCL.EQ.'RGB')THEN
        IF(JCOL.GE.0)THEN
CQWVF     JTEMP=RGBTOINTEGER(IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
CQWVF     ISTATUS=SETBKCOLORRGB(JTEMP)
        ELSE
          AVAL=ABS(REAL(JCOL)/100.)*255.
          IVAL=INT(AVAL+0.5)
          IF(IVAL.LT.0)IVAL=0
          IF(IVAL.GT.255)IVAL=255
          JTEMP=IVAL
CQWVF     JTEMP2=RGBTOINTEGER(JTEMP,JTEMP,JTEMP)
CQWVF     ISTATUS=SETBKCOLORRGB(JTEMP2)
        ENDIF
      ELSE
CQWVF   ISTATS=SETBKCOLOR(JCOL)
      ENDIF
CQWVF CALL CLEARSCREEN($GCLEARSCREEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IOPGOF.EQ.'OFF')GOTO4899
      CALL GLCLEA
      CALL GLCHEC(IEXPOSE,IERRNO)
      IF(IERRNO.EQ.0)GOTO4819
      WRITE(ICOUT,4821)
 4821 FORMAT(1X,'WARNING: OPEN-GL GRAPHICS WINDOW HAS BEEN DESTROYED.')
      CALL DPWRST('XXX','BUG ')
      IOPGOF='OFF'
      GOTO4899
 4819 CONTINUE
      IF(IEXPOSE.NE.1)GOTO4809
      IJUNK=0
      CALL GLUPDA(IJUNK)
 4809 CONTINUE
      IXTEMP = INT(ANUMHP+0.5)
      IYTEMP = INT(ANUMVP+0.5)
      IF(IORNSW.EQ.'LAND')THEN
        IORIEN=0
      ELSE IF(IORNSW.EQ.'PORT')THEN
        IORIEN=1
      ELSE IF(IORNSW.EQ.'SQUA')THEN
        IORIEN=3
      ELSE
        IORIEN=2
      END IF
      ATEMP=255.0
      ARED=REAL(IRED(JCOL))/ATEMP
      AGREEN=REAL(IGREEN(JCOL))/ATEMP
      ABLUE=REAL(IBLUE(JCOL))/ATEMP
      CALL GLERAS(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,ARED,AGREEN,ABLUE)
      ANUMHP=REAL(IXPIX)
      ANUMVP=REAL(IYPIX)
4899  CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
CINTE CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
CINTE CALL IgrColourN(0)
CINTE CALL IGrArea(0.,1.,0.,1.)
CINTE CALL IClearScreen()
CINTE CALL IGrUnits(0.0,100.0,0.0,100.0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(IWINCL.EQ.'RGB')THEN
CWINT   CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
CWINT   CALL IgrColourN(0)
      ELSE
CWINT   CALL IgrColourN(0)
      ENDIF
CWINT CALL IGrArea(0.,1.,0.,1.)
CWINT CALL IGrAreaClear()
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY ROUTINES                    **
C               ******************************************************
C
 5100 CONTINUE
      IF(IZETSW.EQ.'ON')GOTO5190
      IPEN=-3
      YNEW=0.
      DOTPPI=1000.
      XPAGE=ANUMHP/DOTPPI
      XNEW=XPAGE+1.
      CALL PLOT(XNEW,YNEW,IPEN)
 5190 CONTINUE
      IZETSW='OFF'
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO ERASE SCREEN---                              **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRERSC TO ERASE RAMTEK DEVICE')
      ICSTR(1:44)='FIX SUBROUTINE GRERSC TO ERASE RAMTEK DEVICE'
      NCSTR=44
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               **             PAGES 96 AND 145                     **
C               ******************************************************
C
 6600 CONTINUE
CSUN  CALL cfclrvws(ivsnam,0,0)
CCCCC CALL cfclosecgi()
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO ERASE SCREEN---                              **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRERSC TO ERASE XXXXXX DEVICE')
      ICSTR(1:44)='FIX SUBROUTINE GRERSC TO ERASE XXXXXX DEVICE'
      NCSTR=44
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO ERASE SCREEN---                              **
C               **  WRITE OUT AN ESC P p S ( E ) ESC \                **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 96 AND 145                     **
C               **  JANUARY, 1991.  ADD SUPPORT FOR COLOR REGIS.    **
C               **  DEFINE COLOR MAP LOCATION TO 0, DEFINE BACKGROUND*
C               **  COLOR IN LOCATION 0.                            **
C               ******************************************************
C
 8100 CONTINUE
      IF(IGCOLO.EQ.'ON')GOTO8190
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='Pp'
      ICSTR(4:7)='S(E)'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 8190 CONTINUE
      ICSTR(1:25)='S(M0(AH   L   S   ))S(I0)'
      NCHTOT=3
      ITEMP=IRGHUE(JCOL)
      NCSTR=7
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ITEMP=IRGLGT(JCOL)
      NCSTR=11
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ITEMP=IRGSAT(JCOL)
      NCSTR=15
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ICSTR(26:26)=IESCC
      ICSTR(27:28)='Pp'
      ICSTR(29:32)='S(E)'
      NCSTR=32
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  TO PRINT CURRENT PAGE - SHOWPAGE                **
C               **  ALSO SET NEW PAGE AS EITHER LANDSCAPE OR        **
C               **  PORTRAIT ORIENTATION.                           **
C               **  THE "GRESTORE/GSAVE" PAIR RESETS THE DEFAULT AND**
C               **  THE NEW "TRANSFORMATION" MATRIX IS DEFINED.     **
C               **  REFERENCE - POSTSCRIPT LANGUAGE TUTORIAL AND    **
C               **              COOKBOOK FROM ADOBE SYSTEMS         **
C               **  PAGE - 19                                       **
C               **  MODIFIED JANUARY, 1990.                         **
C               **  A) ADD CODE TO MAKE A "CONFORMING" POSTSCRIPT   **
C               **     FILE                                         **
C               **  B) SUPPORT ENCAPSULATED POSTSCRIPT.  NOTE THAT  **
C               **     FOR ENCAPSULATED POSTSCRIPT, EACH PAGE MUST  **
C               **     BE A SELF-CONTAINED FILE, SO EACH PAGE WILL  **
C               **     REPEAT WHAT WOULD NORMALLY BE IN THE GRINDE  **
C               **     GREXIT ROUTINES.                             **
C               ******************************************************
C
C  NOVEMBER, 1990 BUG FIX.  MODIFY HOW MARGINS HANDLED.
C  OCTOBER, 1991. MAKE FONTS TABLE DRIVEN (EASIER UPDATING, SIMPLER CODE)
C  JANUARY 1993.  ONLY UPDATE PAGE NUMBER FOR DEVICE 2 (DEVICE 3
C  ALWAYS 1).
C  JANUARY 1993.  FOR "%%" LINES, CHECK FOR LEADING SPACE (FRAMEMAKER
C  WON'T ACCEPT IF LEADING SPACE PRESENT).
C  OCTOBER 1993.  FOR COLOR POSTSCRIPT, SET BACKGROUND COLOR.
C  JANUARY 2003: FOR REGULAR POSTSCRIPT, HAVE A CHECK FOR INITIAL PAGE
C                ERASE (I.E., GRINDE DOES INITIAL PAGE, NO NEED TO
C                REPEAT HERE).  THIS WILL SUPPRESS THE INITIAL BLANK
C                PAGE.
C
 8600 CONTINUE
CCCCC JANUARY 1993.  ONLY COUNT FOR DEVICE 2.
CCCCC JANUARY 2003.  IPSTNW USED TO ACCOUNT FOR INITIAL PAGE ERASE
CCCCC IPSTPN=IPSTPN+1
      IF(IMODE3.NE.'DEV3')THEN
        IF(IPSTNW.EQ.'ON')THEN
          IPSTNW='OFF'
          IF(IMODEL.EQ.'ENCA')GOTO8710
          GOTO9000
        ELSE
          IPSTPN=IPSTPN+1
        ENDIF
      ENDIF
CCCCC END CHANGE
CCCCC JANUARY 1993.  ADD FOLLOWING LINE
      IF(IPSTSP.EQ.'OFF'.OR.IPSTSP.EQ.'NO'.OR.IPSTSP.EQ.'FALS')
     1 IPSTSP='OFF'
CCCCC ENCAPSULATED POSTSCRIPT HANDLED DIFFERENTLY
      IF(IMODEL.EQ.'ENCA')GOTO8710
C
CCCCC THE FOLLOWING 12 LINES WERE ADDED MAY 1992 (JJF)
CCCCC IF(IPSTBP.EQ.'ON'.OR.IPSTPN.GE.3)THEN
CCCCC IF(IMODE3.NE.'DEV3'.AND.IPSTPN.GE.3)THEN
      IF(IMODE3.NE.'DEV3')THEN
         ICSTR(1:8)='showpage'
         NCSTR=8
         CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
      IF(IMODE3.EQ.'DEV3')THEN
         IF(IPSTBP.EQ.'ON')THEN
            ICSTR(1:8)='showpage'
            NCSTR=8
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
         ENDIF
      ENDIF
C
      ICSTR(1:8)='grestore'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  FOLLOWING SECTION ADDED JANUARY, 1990
      ICSTR(1:8)='%%Page: '
      NCHTOT=5
      NCSTR=8
CCCCC JANUARY 1993.  ADD FOLLOWING LINE
      CALL GRTRIN(IPSTPN,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPSTPN,NCHTOT,ICSTR,NCSTR)
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:5)='gsave'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:11)='0 0 moveto '
      NCSTR=11
      XPPI=PSTPPI
      YPPI=PSTPPI
      XSCALE=72./XPPI
      YSCALE=72./YPPI
      NCSTR=11
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(22:22)=' '
      NCSTR=22
      CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(33:39)=' scale '
      NCSTR=39
C
CCCCC IXTR=IOFFSH
CCCCC IYTR=IOFFSV
CCCCC IF(IORNSW.NE.'PORT')IXTR=IOFFSH+ANUMVP+0.5
      IF(IORNSW.EQ.'LAND')THEN
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'PORT')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSE
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      END IF
      IXTR=IHTEMP
      IYTR=IVTEMP
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1IXTR=IHTEMP+ANUMVP+0.5
      NCHTOT=5
      CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(45:45)=' '
      NCSTR=45
      CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(51:61)=' translate '
C
      ICSTR(62:63)=' 0'
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1ICSTR(62:63)='90'
      ICSTR(64:71)=' rotate '
      NCSTR=71
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  NOTE: NEW PAGE DOES A RESTORE, WHICH SETS INITIAL FONT SIZE
C        SO SET CURRENT FONT SIZE TO ORIGINAL FONT SIZE
      IPSTPC=IPSTPO
C  JUNE, 1989.  A NEW PAGE RESETS THE FONT TO WHAT IS SET IN GRINDE.
C  ADDED IPSTFO TO DPCODV COMMON BLOCK.
      IPSTFC=IPSTFO
CCCCC OCTOBER 1993.  FILL BACKGROUND FOR COLOR POSTSCRIPT.
CCCCC NOTE THAT THIS WILL ONLY BE DONE FOR COLOR POSTSCRIPT DEVICES
      IF(IGCOLO.NE.'ON')GOTO9000
CCCCC SET A GREYSCALE COLOR
      IF(JCOL.LT.0)THEN
        AVAL=REAL(JCOL)/100.
        AVAL=ABS(AVAL)
        IF(AVAL.LE.0.0)AVAL=0.0
        IF(AVAL.GE.1.0)AVAL=1.0
        NCSTR=0
        NCHTOT=7
        NCHDEC=5
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+10
        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
        NCSTR=NCSTR2
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC SET A NON-GRAY SCALE COLOR
      ELSE
        AVAL=REAL(IRED(JCOL))/255.
        NCSTR=0
        NCHTOT=7
        NCHDEC=5
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        AVAL=REAL(IGREEN(JCOL))/255.
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        AVAL=REAL(IBLUE(JCOL))/255.
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+10
        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
        NCSTR=NCSTR2
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
CCCCC FILL A RECTANGLE WITH THE COLOR
      PX(1)=0.
      PX(2)=100.
      PX(3)=100.
      PX(4)=0.
      PX(5)=0.
      PY(1)=0.
      PY(2)=0.
      PY(3)=100.
      PY(4)=100.
      PY(5)=0.
      NP=5
      NCHTOT=5
      NCSTR=0
      CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' m'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO8811I=2,NP
      NCSTR=0
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' l'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8811 CONTINUE
      ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C  JANUARY, 1990.  ADD CODE FOR ENCAPSULATED POSTSCRIPT.  NOTE THAT EACH
C  PAGE MUST BE SELF-CONTAINED, SO MIMIC CODE FROM GREXIT AND GRINDE USED
C  BY REGULAR POSTSCRIPT.
C
 8710 CONTINUE
      IF(IPSTPN.LE.1)GOTO8719
      ICSTR(1:8)='showpage'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:3)='end'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:8)='grestore'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='%%Trailer'
      NCSTR=9
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:33)='% END OF DATAPLOT POSTSCRIPT PAGE'
      NCSTR=33
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC JANUARY 1993.  CHECK FOR LEADING SPACE ON "%%" LINES
 8719 CONTINUE
      ICSTR(1:23)='%!PS-Adobe-2.0 EPSF-1.2'
      NCSTR=23
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='%%Creator: Dataplot'
      NCSTR=19
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:46)='%%Title: Dataplot Encapsulated Postscript File'
      NCSTR=46
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:20)='%%CreationDate: NULL'
      NCSTR=20
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:40)='%%DocumentFonts: Times-Roman Times-Bold '
      ICSTR(41:69)='Times-Italic Times-BoldItalic'
      NCSTR=69
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:46)='%%+ Helvetica Helvetica-Bold Helvetica-Oblique'
      ICSTR(47:76)=' Helvetica-BoldOblique Courier'
      NCSTR=76
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:33)='%%+ Courier-Bold Courier-Oblique '
      ICSTR(34:53)=' Courier-BoldOblique'
      NCSTR=53
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  OCTOBER 1991.  ADDITIONAL FONTS ADDED
      ICSTR(1:42)='%%+ AvantGarde-Book AvantGarde-BookOblique'
      ICSTR(43:81)=' AvantGarde-Demi AvantGarde-DemiOblique'
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Bookman-Demi Bookman-DemiItalic       '
      ICSTR(43:81)='Bookman-Light Bookman-LightItalic      '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Helvetica-Narrow Helvetica-Narrow-Bold'
      ICSTR(43:81)=' Helvetica-Narrow-BoldOblique          '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Helvetica-Narrow-Oblique              '
      ICSTR(43:81)='NewCentury-Schlbk-Bold                 '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ NewCentury-Schlbk-Italic              '
      ICSTR(43:81)='NewCenturySchlbk-BoldItalic            '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Palatino-Roman Palatino-Bold          '
      ICSTR(43:81)='Palatino-Italic Palatino-BoldItalic    '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ ZapfChancery-Medium Italic Symbol     '
      ICSTR(43:81)='                                       '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  END CHANGE
C  JANUARY 1993.  FOLLOWING 9 LINES MOVED
CCCCC ICSTR(1:48)='% BoundingBox given in Postscript default units '
CCCCC ICSTR(49:75)='(72 ppi), accomodate either'
CCCCC NCSTR=75
CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:41)='% portrait or landscape mode at 11 inches'
CCCCC NCSTR=41
CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC NOVEMBER 1996.  FOLLOWING SECTION MODIFIED TO BASE BOUNDING BOX
CCCCC ON WHETHER OR NOT USE LANDSCAPE, PORTRAIT, OR LANDSCAPE
CCCCC WORDPERFECT (LAN2) MODE USED.
      IF(IORNSW.EQ.'PORT')THEN
        ICSTR(1:26)='%%BoundingBox: 0 0 612 792'
        NCSTR=26
      ELSEIF(IORNSW.EQ.'LAND')THEN
        ICSTR(1:26)='%%BoundingBox: 0 0 792 612'
        NCSTR=26
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        ICSTR(1:26)='%%BoundingBox: 0 0 612 468'
        NCSTR=26
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        ICSTR(1:26)='%%BoundingBox: 0 0 612 612'
        NCSTR=26
      ELSE
        ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
        NCSTR=26
      ENDIF
CCCCC NCHTOT=5
CCCCC IJUNK=11*72
CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=' '
CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='%%EndComments'
      NCSTR=13
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC JANUARY 1993.  FOLLOWING 9 LINES MOVED HERE.
CCCCC NOVEMBER 1996.  FOLLOWING SECTION COMMENTED OUT
CCCCC ICSTR(1:48)='% BoundingBox given in Postscript default units '
CCCCC ICSTR(49:75)='(72 ppi), accomodate either'
CCCCC NCSTR=75
CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:41)='% portrait or landscape mode at 11 inches'
CCCCC NCSTR=41
CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:43)='% DATAPLOT POSTSCRIPT DRIVER, JANUARY, 1990'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:43)='% PROLOG SECTION: DATAPLOT DEFINITIONS     '
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='15 dict begin'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:43)='% REDEFINE "showpage" TO BE A NULL OPERATOR'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:16)='/showpage {} def'
      NCSTR=16
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "rightshow" TO PRINT RIGHT'
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:20)='% (STRING) rightshow'
      NCSTR=20
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/rightshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IX exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   IY moveto'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "centshow" TO PRINT CENTER'
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='% (STRING) centshow'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='/centshow'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:8)='   2 div'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IX exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   IY moveto'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "leftshow" TO PRINT LEFT  '
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='% (STRING) leftshow'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='/leftshow'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:25)='  {IX IY moveto show} def'
      NCSTR=25
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vrightshow" TO PRINT RIGHT'
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:30)='% (STRING) vrightshow grestore'
      NCSTR=30
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='/vrightshow'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IY exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='   IX exch moveto'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='    90 rotate'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vcentshow" TO PRINT CENTER'
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:29)='% (STRING) vcentshow grestore'
      NCSTR=29
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/vcentshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:8)='   2 div'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IY exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='   IX exch moveto'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='     90 rotate'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vleftshow" TO PRINT LEFT  '
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:29)='% (STRING) vleftshow grestore'
      NCSTR=29
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/vleftshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:36)='  {IX IY moveto 90 rotate show} def'
      NCSTR=36
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:52)='% DEFINE PROCEDURE "l" AS ABBREVIATION OF lineto'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:15)='/l {lineto} def'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:52)='% DEFINE PROCEDURE "m" AS ABBREVIATION OF moveto'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:15)='/m {moveto} def'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      APOINT=ANUMVP*2.0/100.
      IPOINT=INT(APOINT)
C  FOLLOWING CODE MODIFIED OCTOBER 1991.
      IJUNK=7
      DO8695I=1,IPSTMF
      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
      IJUNK=I
      GOTO8697
 8695 CONTINUE
 8697 CONTINUE
      ICSTR(1:1)='/'
      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
      ICSTR(42:51)=' findfont '
      NCHTOT=3
      NCSTR=51
      CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+17
      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:33)='/Times-Roman            findfont '
CCCCC IF(IPSTFN.EQ.'TBOL')
CCCCC1ICSTR(1:23)='/Times-Bold            '
CCCCC IF(IPSTFN.EQ.'TITA')
CCCCC1ICSTR(1:23)='/Times-Italic          '
CCCCC IF(IPSTFN.EQ.'TBIT')
CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
CCCCC IF(IPSTFN.EQ.'HELV')
CCCCC1ICSTR(1:23)='/Helvetica             '
CCCCC IF(IPSTFN.EQ.'HELB')
CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
CCCCC IF(IPSTFN.EQ.'HELO')
CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
CCCCC IF(IPSTFN.EQ.'HEBO')
CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
CCCCC IF(IPSTFN.EQ.'COUR')
CCCCC1ICSTR(1:23)='/Courier               '
CCCCC IF(IPSTFN.EQ.'CBOL')
CCCCC1ICSTR(1:23)='/Courier-Bold          '
CCCCC IF(IPSTFN.EQ.'COBL')
CCCCC1ICSTR(1:23)='/Courier-Oblique       '
CCCCC IF(IPSTFN.EQ.'CBOB')
CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
CCCCC NCSTR=33
CCCCC NCHTOT=3
CCCCC CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(37:54)=' scalefont setfont'
CCCCC NCSTR=54
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  END CHANGE
      IPSTFC=IPSTFN
      IPSTPS=IPOINT
      IPSTPC=IPOINT
      IPSTPO=IPOINT
      IPSTFO=IPSTFN
C
      ICSTR(1:41)='gsave    % SAVE INITIAL GRAPHICS STATE'
      NCSTR=41
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  ADD FOLLOWING LINES JANUARY, 1990.
      ICSTR(1:11)='%%EndProlog'
      NCSTR=11
CCCCC JANUARY 1993.  ADD FOLLOWING LINE
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='0 0 moveto '
      NCSTR=11
      XPPI=PSTPPI
      YPPI=PSTPPI
      XSCALE=72./XPPI
      YSCALE=72./YPPI
      NCSTR=11
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(22:22)=' '
      NCSTR=22
      CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(33:39)=' scale '
      NCSTR=39
C
      IF(IORNSW.EQ.'LAND')THEN
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'PORT')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSE
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      END IF
      IXTR=IHTEMP
      IYTR=IVTEMP
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1IXTR=IHTEMP+ANUMVP+0.5
      NCHTOT=5
      CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(45:45)=' '
      NCSTR=45
      CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(51:61)=' translate '
C
      ICSTR(62:63)=' 0'
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1ICSTR(62:63)='90'
      ICSTR(64:71)=' rotate '
      NCSTR=71
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC OCTOBER 1993.  FILL BACKGROUND FOR COLOR POSTSCRIPT.
CCCCC NOTE THAT THIS WILL ONLY BE DONE FOR COLOR POSTSCRIPT DEVICES
      IF(IGCOLO.NE.'ON')GOTO9000
CCCCC SET A GREYSCALE COLOR
      IF(JCOL.LT.0)THEN
        AVAL=REAL(JCOL)/100.
        AVAL=ABS(AVAL)
        IF(AVAL.LE.0.0)AVAL=0.0
        IF(AVAL.GE.1.0)AVAL=1.0
        NCSTR=0
        NCHTOT=7
        NCHDEC=5
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+10
        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
        NCSTR=NCSTR2
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC SET A NON-GRAY SCALE COLOR
      ELSE
        AVAL=REAL(IRED(JCOL))/255.
        NCSTR=0
        NCHTOT=7
        NCHDEC=5
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        AVAL=REAL(IGREEN(JCOL))/255.
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        AVAL=REAL(IBLUE(JCOL))/255.
        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        NCSTR=NCSTR+1
        NCSTR2=NCSTR+10
        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
        NCSTR=NCSTR2
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
CCCCC FILL A RECTANGLE WITH THE COLOR
      PX(1)=0.
      PX(2)=100.
      PX(3)=100.
      PX(4)=0.
      PX(5)=0.
      PY(1)=0.
      PY(2)=0.
      PY(3)=100.
      PY(4)=100.
      PY(5)=0.
      NP=5
      NCHTOT=5
      NCSTR=0
      CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' m'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO8911I=2,NP
      NCSTR=0
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' l'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8911 CONTINUE
      ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  TO PRINT CURRENT PAGE - "^,"                    **
C               **  REFERENCE - QUIC PROGRAMMING MANUAL             **
C               **  PAGES 5-10, 5-11
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:2)=','
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  1) CLEAR THE BUFFER (TO FINISH CURRENT PLOT)    **
C               **     AND OPTIONALLY WAIT FOR CARRIAGE RETURN      **
C               **  2) CHECK THE "INPUT" BUFFER FOR CONFIG AND      **
C               **     WINDOW EVENTS                                **
C               **  3) CLEAR THE WINDOW                             **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9699
      CALL XCLEAR
      IF(IX11PA.EQ.'OFF')GOTO9601
CCCCC WRITE(ICOUT,9605)
C9605 FORMAT('PRESS CARRIAGE RETURN TO CONTINUE:')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC READ(IRD,'(A1)')IA
 9601 CONTINUE
      CALL XCHECK(IEXPOSE,IERRNO)
      IF(IERRNO.EQ.0)GOTO9619
      WRITE(ICOUT,9621)
 9621 FORMAT(1X,'WARNING: X11 GRAPHICS WINDOW HAS BEEN DESTROYED.')
      CALL DPWRST('XXX','BUG ')
      IX11OF='OFF'
      GOTO9699
 9619 CONTINUE
      IF(IEXPOSE.NE.1)GOTO9609
      IF(IX11PM.EQ.'OFF')GOTO9609
CCCCC MAY 1996.  ADD FOLLOWING LINE, ADD ARGUMENT TO XUPDAT
      IJUNK=0
CCCCC CALL XUPDAT
      CALL XUPDAT(IJUNK)
CCCCC WRITE(ICOUT,9605)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC READ(IRD,'(A1)')IA
 9609 CONTINUE
      IXTEMP = INT(ANUMHP+0.5)
      IYTEMP = INT(ANUMVP+0.5)
      IF(IORNSW.EQ.'LAND')THEN
        IORIEN=0
      ELSE IF(IORNSW.EQ.'PORT')THEN
        IORIEN=1
      ELSE IF(IORNSW.EQ.'SQUA')THEN
        IORIEN=3
      ELSE
        IORIEN=2
      END IF
      IPIX=0
      IF(IX11PM.EQ.'ON')IPIX=1
      CALL XERASE(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,JCOL,IPIX)
      ANUMHP=REAL(IXPIX)
      ANUMVP=REAL(IYPIX)
9699  CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
10000 CONTINUE
      CALL TCERSC(ICOLT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CGKS  CALL GCLRWK(IGKSID, IGKSCL)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      IXTEMP=ANUMHP
      IYTEMP=ANUMVP
C
      IF(IGUNIT.EQ.44)THEN
        DO12001I=80,1,-1
          ILAST=I
          IF(IPL2NA(I:I).NE.' ')GOTO12009
12001   CONTINUE
        ILAST=1
12009   CONTINUE
      ELSE
        DO12010I=80,1,-1
          ILAST=I
          IF(IPL1NA(I:I).NE.' ')GOTO12019
12010   CONTINUE
        ILAST=1
12019   CONTINUE
      ENDIF
C
      DO12020I=1,ILAST
        CALL DPCOAN(IPL1NA(I:I),IJUNK)
        IADE(I)=IJUNK
12020 CONTINUE
      IADE(ILAST+1)=0
      CALL GDERAS(IXTEMP,IYTEMP,JCOL,IADE)
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      NPLOT=1
CAQUA CALL aqtOpenPlot(NPLOT)
CAQUA CALL aqtSetPlotSize(ANUMHP,ANUMVP)
CAQUA CALL aqtSetPlotTitle('Dataplot Graphics Window')
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)            DRIVER **
C               ******************************************************
15000 CONTINUE
      IF(ILATOS.EQ.'ON')THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:13)='end{picture}'
        NCSTR=13
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:1)=IBASLC
        ICSTR(2:8)='newpage'
        NCSTR=8
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
C
      ILATOS='ON'
C
      ICSTR(1:1)=IBASLC
      ICSTR(2:31)='setlength{ unitlength}{0.24pt}'
      ICSTR(12:12)=IBASLC
      NCSTR=31
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)=IBASLC
      ICSTR(2:16)='begin{picture}('
      NCSTR=16
      NCHTOT=5
      CALL GRTRIN(NUMHPP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      NCHTOT=5
      CALL GRTRIN(NUMVPP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ILATCO.EQ.'ON' .AND. JCOL.NE.0)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:16)='pagecolor{    }'
        ICSTR(13:16)=ICOLT(1:4)
        NCSTR=16
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL DPCONA(34,IQUOTE)
C
      IF(ISVGOS.EQ.'ON')THEN
        IF(ISVGCN.GT.0)THEN
          ICSTR(1:7)='   </g>'
          NCSTR=-7
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:6)='</svg>'
          NCSTR=-6
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:26)='<!--  END OF SVG GRAPH -->'
          NCSTR=-26
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:1)=' '
          NCSTR=-1
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
      ELSE
        ISVGOS='ON'
      ENDIF
      ISVGCN=ISVGCN+1
C
      IF(ISVGCN.GT.1)THEN
        ICSTR(1:14)='<?xml version='
        ICSTR(15:15)=IQUOTE
        ICSTR(16:18)='1.0'
        ICSTR(19:19)=IQUOTE
        ICSTR(20:31)=' standalone='
        ICSTR(32:32)=IQUOTE
        ICSTR(33:34)='no'
        ICSTR(35:35)=IQUOTE
        ICSTR(36:37)='?>'
        NCSTR=-37
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:21)='<!DOCTYPE svg PUBLIC '
        ICSTR(22:22)=IQUOTE
        ICSTR(23:45)='-//W3C//DTD SVG 1.0//EN'
        ICSTR(46:46)=IQUOTE
        NCSTR=-46
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:5)='     '
        ICSTR(6:6)=IQUOTE
        ICSTR(7:49)='http://www.w3.org./TR/2001/PR-SVG-20010719/'
        ICSTR(50:62)='DTD/svg10.dtd'
        ICSTR(63:63)=IQUOTE
        ICSTR(64:64)='>'
        NCSTR=-64
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCHTOT=6
        IXTEMP=ANUMHP
        IYTEMP=ANUMVP
C
        ICSTR(1:11)='<svg width='
        ICSTR(12:12)=IQUOTE
        NCSTR=12
        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+7)=' height='
        NCSTR=NCSTR+8
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:13)='     viewBox='
        ICSTR(14:14)=IQUOTE
        ICSTR(15:18)='0 0 '
        NCSTR=18
        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=' '
        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='>'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:9)='   <desc>'
        NCSTR=-9
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:47)='   SVG GRAPHIC CREATED BY DATAPLOT: MARCH, 2002'
        ICSTR(48:56)=' VERSION.'
        NCSTR=-56
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:10)='   </desc>'
        NCSTR=-10
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:9)='   <g id='
        ICSTR(10:10)=IQUOTE
        ICSTR(11:15)='graph'
        NCSTR=15
        NCHTOT=1
        IF(ISVGCN.GT.9)NCHTOT=2
        IF(ISVGCN.GT.99)NCHTOT=3
        IF(ISVGCN.GT.999)NCHTOT=4
        IF(ISVGCN.GT.9999)NCHTOT=5
        CALL GRTRIN(ISVGCN,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='>'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  CREATE BACKGROUND VIA FILLED RECTANGLE
C
        ICSTR(1:11)='   <rect x='
        NCSTR=-11
        ICSTR(12:12)=IQUOTE
        ICSTR(13:13)='0'
        ICSTR(14:14)=IQUOTE
        ICSTR(15:17)=' y='
        ICSTR(18:18)=IQUOTE
        ICSTR(19:19)='0'
        ICSTR(20:20)=IQUOTE
        NCSTR=-20
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:15)='         width='
        ICSTR(16:16)=IQUOTE
        NCSTR=16
        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+7)=' height='
        NCSTR=NCSTR+8
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(ISVGSS(1:3).EQ.'EXT')THEN
          ICSTR(1:17)='           class='
          ICSTR(18:18)=IQUOTE
          ICSTR(19:28)='background'
          ICSTR(29:29)=IQUOTE
          NCSTR=-29
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          ICSTR(1:17)='           style='
          ICSTR(18:18)=IQUOTE
          ICSTR(19:31)='stroke:none; '
          NCSTR=-31
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:19)='             fill:#'
          NCSTR=19
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+2
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:5)='   />'
          NCSTR=-5
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
      ENDIF
C
      GOTO9000
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ERSC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRERSC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)JCOL
 9012 FORMAT('JCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGBAUD,AGERDE
 9013 FORMAT('IGBAUD,AGERDE = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICHAPS,INULLI
 9014 FORMAT('ICHAPS,INULLI = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IESCC,IFFC,ISYNC
 9015 FORMAT('IESCC,IFFC,ISYNC = ',A1,2X,A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1992
      WRITE(ICOUT,9016)IPL2CS,IPSTBP,IPSTPN
 9016 FORMAT('IPL2CS,IPSTBP,IPSTPN = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IMANUF,IMODEL
 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IGUNIT,IX
 9019 FORMAT('IGUNIT,IX = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GREXIT
C
C     PURPOSE--TO SHUT DOWN A DEVICE BEFORE EXIT DATAPLOT
C              TO DEFAULT POWER-ON CONDITIONS.
C              PERFORMS FUNCTION ANALOGOUS TO GRINDE
C              (GRINDE DONE WHEN DEVICE FIRST TURNED ON,
C              GREXIT WHEN EXIT DATAPLOT.  THIS ROUTINE
C              REQUIRED BY MANY LASER PRINTERS TO FORCE A PAGE
C              ERASE BEFORE EXITING.
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89.2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --MARCH     1990.  X11 DEVICE ADDED (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --AUGUST   1992. UPDATE FOR HP-GL (LASER JET III)
C     UPDATED         --JANUARY  1993. POSTSCRIPT "%%" LINES (ALAN)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE, OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*130 ICSTR
      CHARACTER*130 IATEMP
      CHARACTER*4 ISUBN0
CCCCC CHARACTER*1 IQUOTE
      CHARACTER*1 ICARAT
C  FEBRUARY 2001. ADD FOLLOWING SECTION FOR JPEG/PNG DRIVER.
      INTEGER IADE(81)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
      CHARACTER*4 IERRF1
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XEND
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='EXIT'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'EXIT')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GREXIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
   56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4020')GOTO1100
      IF(IMODEL.EQ.'4022')GOTO1100
      IF(IMODEL.EQ.'4025')GOTO1100
      IF(IMODEL.EQ.'4027')GOTO1100
C
      IF(IMODEL.EQ.'4105')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4109')GOTO1200
      IF(IMODEL.EQ.'4115')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4113')GOTO1200
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
 1097 CONTINUE
      GOTO15000
C
 1099 CONTINUE
      GOTO16000
C
C               ***************************************************
C               **  STEP 11--                                    **
C               **  TREAT THE TEKTRONIX 4027 CASE--              **
C               **  (A COLOR TERMINAL).                          **
C               ***************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ****************************************************************
C               **  STEP 2--
C               **  TREAT THE TEKTRONIX 4105 CASE
C               **  (A COLOR DEVICE)
C               ****************************************************************
C
 1200 CONTINUE
      GOTO9000
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               ******************************************************
C
C  AUGUST 1992.  UPDATE FOR LASER JET III.
C
 2200 CONTINUE
      ICSTR(1:3)='SP;'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(IMODE3.NE.'LJET')GOTO9000
      ICSTR(1:1)=IESCC
      ICSTR(2:2)='E'
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL (LASER JET) CASE      **
C               **  LANDSCAPE ORIENTATION                               **
C               **  TO TERMINATE DEVICE, FORCE A PAGE ERASE             **
C               **  REFERENCE--                                         **
C               **     LASERJET SERIES II PRINTER, TECHNICAL REFERENCE  **
C               **             MANUAL, CHAPTERS 4, 5, 8                 **
C               **********************************************************
C
 2600 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='&l0H'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)='E'
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 33--                                    **
C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE  **
C               **  1) CHECK IF A "PICTURE" IS CURRENTLY ACTIVE  **
C               **  2) END OF METAFILE                           **
C               ***************************************************
C
 3300 CONTINUE
      IF(ICGMSW.EQ.'OFF')GOTO3310
      ICSTR(1:7)='ENDPIC;'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3310 CONTINUE
      ICSTR(1:6)='ENDMF;'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               **  1) CHECK IF A "PICTURE" IS CURRENTLY ACTIVE  **
C               **  2) END OF METAFILE                           **
C               ***************************************************
C
 3400 CONTINUE
      IF(ICGMSW.EQ.'OFF')GOTO3310
      ICSTR(1:7)='ENDPIC;'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3410 CONTINUE
      ICSTR(1:6)='ENDMF;'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  USE CALCOMP LIBRARY ROUTINE                     **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      IPEN=999.
      XNEW=0.
      YNEW=0.
      CALL PLOT(XNEW,YNEW,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
C
C  ILAHSW  = ON IF GRAPHICS MODE SET, OFF IF NORMAL VIDEO MODE SET
C
CCCCC IF(ILAHSW.EQ.'ON')THEN
        IPEN=999
        XNEW=0.
        YNEW=0.
        CALL PLOT(XNEW,YNEW,IPEN)
CCCCC ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      CALL GLEND()
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
CINTE CALL IScreenQuit('C')
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IHAND2=1
CCCCC CALL WindowCloseChild(IHAND2)
CWINT CALL WindowClose()
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO INITIALIZE DEVICE--                          **
C               **  USE THE 70 OP CODE (= RESET)                    **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 , B-1, AND E-1             **
C               ******************************************************
C
 5100 CONTINUE
      IPEN=999.
      XNEW=0.
      YNEW=0.
      CALL PLOT(XNEW,YNEW,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO INITIALIZE DEVICE--                          **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               **  WRITTEN BY BILL ANDERSON                        **
C               ******************************************************
C
 6600 CONTINUE
CSUN  CALL cfclosevws(IVSNAM)
CSUN  CALL cfclosecgi()
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO INITIALIZE DEVICE--                          **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO INITIALIZE DEVICE---                         **
C               **  WRITE OUT AN   XX                               **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 85.1--                                     **
C               **  TREAT THE POSTSCRIPT  CASE                      **
C               **  1) PRINT THE CURRENT PAGE                       **
C               **  2) RESTORE PAGE DEFAULTS                        **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **             COOKBOOK, ADOBE SYSTEMS              **
C               **  MODIFIED JANUARY, 1990 TO MAKE "CONFORMING" STYLE*
C               ******************************************************
C
 8600 CONTINUE
      ICSTR(1:8)='showpage'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  JANUARY, 1990.  FOLLOWING 4 LINES ADDED FOR ENCAPSULATED POSTSCRIPT
      IF(IMODEL.NE.'ENCA')GOTO8613
      ICSTR(1:3)='end'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8613 CONTINUE
      ICSTR(1:8)='grestore'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  JANUARY, 1990.  FOLLOWING LINES ADDED.
      ICSTR(1:9)='%%Trailer'
      NCSTR=9
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(IMODEL.EQ.'ENCA')GOTO8610
      ICSTR(1:9)='%%Pages: '
      NCHTOT=5
      NCSTR=9
CCCCC JANUARY 1993.  HANDLE DEVICE 2 AND DEVICE 3 SEPARATELY.
      NTEMP=IPSTPN
      IF(IMODE3.EQ.'DEV3')NTEMP=1
      CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
CCCCC CALL GRTRIN(IPSTPN,NCHTOT,ICSTR,NCSTR)
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8610 CONTINUE
      ICSTR(1:33)='% END OF DATAPLOT POSTSCRIPT FILE'
      NCSTR=33
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 90--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  1) PRINT CURRENT PAGE - "^,"                    **
C               **  2) RESET DEFAULTS - "^ISYNTAX00000"             **
C               **  3) TURN QUIC OFF  - "^-^PN-"                    **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:2)=','
      ICSTR(3:3)=ICARAT
      ICSTR(4:15)='ISYNTAX00000'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:2)='-'
      ICSTR(3:3)=ICARAT
      ICSTR(4:5)='PN'
      ICSTR(6:6)=ICARAT
      ICSTR(7:7)='-'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.NE.'OFF')CALL XEND
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CGKS  CALL GCLWK(IGKSWS)
CGKS  CALL GCLKS
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
C
      IF(IGUNIT.EQ.44)THEN
        DO12001I=80,1,-1
          ILAST=I
          IF(IPL2NA(I:I).NE.' ')GOTO12009
12001   CONTINUE
        ILAST=1
12009   CONTINUE
      ELSE
        DO12010I=80,1,-1
          ILAST=I
          IF(IPL1NA(I:I).NE.' ')GOTO12019
12010   CONTINUE
        ILAST=1
12019   CONTINUE
      ENDIF
C
      DO12020I=1,ILAST
        CALL DPCOAN(IPL1NA(I:I),IJUNK)
        IADE(I)=IJUNK
12020 CONTINUE
      IADE(ILAST+1)=0
      CALL GDEND(IADE)
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
CAQUA CALL aqtClosePlot()
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
C
      ICSTR(1:1)=IBASLC
      ICSTR(2:13)='end{picture}'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(IMODEL.NE.'STAN')THEN
C
        ICSTR(1:1)=' '
        NCSTR=1
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:18)='begin{verbatim}'
        NCSTR=18
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ELSEIF(ILATFO.EQ.'NULL')THEN
C
        ICSTR(1:1)=' '
        NCSTR=1
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:16)='end{document}'
        NCSTR=16
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ELSE
        IOUNI1=IST1NU
        IFILE1=ILATFO
        ISTAT1='OLD'
        IFORM1='FORMATTED'
        IACCE1='SEQUENTIAL'
        IPROT1='READONLY'
        ICURS1='CLOSED'
        ISUBN0='CAPT'
        IERRF1='NO'
C
        IREWI1='ON'
        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1                IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
        DO15301I=1,1000
          IATEMP=' '
          READ(IOUNI2,15392,END=15399,ERR=15399)IATEMP
15392     FORMAT(A240)
          ILAST=1
          DO15410J=240,1,-1
            IF(IATEMP(J:J).NE.' ')THEN
              ILAST=J
              GOTO15419
            ENDIF
15410     CONTINUE
15419     CONTINUE
          ICSTR(1:ILAST)=IATEMP(1:ILAST)
          NCSTR=ILAST
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15301   CONTINUE
15399   CONTINUE
        IENDF1='OFF'
        IREWI1='ON'
        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1                IENDF1,IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
        IF(IERRF1.EQ.'YES')GOTO9000
      ENDIF
      ILATOS='OFF'
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      IF(ISVGOS.EQ.'ON')THEN
        ICSTR(1:7)='   </g>'
        NCSTR=-7
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:6)='</svg>'
        NCSTR=-6
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:26)='<!--  END OF SVG GRAPH -->'
        NCSTR=-26
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:1)=' '
        NCSTR=-1
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ISVGOS='OFF'
        ISVGCN=0
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'EXIT')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GREXIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRFIRE(PX,PY,NP,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLF,JCOLF,ICOLP,JCOLP,
     1IPATT2)
C  ABOVE LINE ADDED SEPTEMBER,1987
C
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              FILL THE REGION
C              DEFINED BY THE VERTICES AS GIVEN
C              IN THE PX(.) AND PY(.) VECTORS.
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
C     NOTE--THIS SUBROUTINE IS CALLED BY DPFIRE, DPSCR8, AND DPFIMA
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989. ICOL MADE CHARACTER*4 (BOMB ON FILL)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --AUGUST   1992. POSTSCRIPT COLOR (ALAN)
C     UPDATED         --AUGUST   1992. SET ICOL TO ICOLP (ALAN)
C     UPDATED         --OCTOBER  1993. HATCH PATTERNS FOR NON-BOX AREAS
C                                      (ADD GRFIR3 ROUTINE) (ALAN)
C     UPDATED         --NOVEMBER 1993. "POLY" IN SOFTWARE (ALAN)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JULY     2001. ADD COLOR INDEX ARGUMENT TO
C                                      CALLS TO GRFIR2.
C     UPDATED         --MARCH    2002. LATEX USING EEPIC
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)----------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1989
      CHARACTER*4 ICOL
C
      CHARACTER*1 ICOL2
      CHARACTER*2 ICJUNK
      CHARACTER*1 IQUOTE
C
      CHARACTER*4 IPATT2
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      CHARACTER*4 IFLAG
C
      DIMENSION PX(*)
      DIMENSION PY(*)
C
      DIMENSION PX2(2)
      DIMENSION PY2(2)
C
      DIMENSION IX(100)
      DIMENSION IY(100)
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
C  THERE ARE 3 TYPES OF FILLS:
C  1. A BOX  (SOFTWARE FILL IN GRDRBP)
C  2. A SOLID FILLED SIMPLE (CONCAVE POLYGON) (SOFTWARE FILL IN GRFIR2)
C  3. A GENERAL POLYGON (SOFTWARE FILL IN GRFIR3)
C
C  HARDWARE FILLS ARE DONE FOR CASES 1 AND 2 WHERE THE HARDWARE 
C  PERMITS.  CURRENTLY, ONLY POSTSCRIPT DOES CASE 3 IN HARDWARE.  OTHER
C  DEVICES MAY BE ADDED AS WE GET A CHANCE TO PROPERLY TEST THEM 
C  (HARDWARE FILLS IN THE GENERAL CASE TEND TO BE SOMEWHAT BUGGY, 
C  ALTHOUGH MUCH FASTER WHEN THEY WORK).
C
CCCCC OCTOBER 1993.  MODIFY ALL CALLS TO GRFIR2 TO CALL GRFIR2 FOR
CCCCC SOLID FILLS AND TO GO TO GRFIR3 FOR NON-SOLID FILLS.
CCCCC GRFIR3 CAN HANDLE CONVEX OR CONCAVE POLYGONS.
CCCCC ADD FOLLOWING LINES TO DETECT SOLID OR VERTICAL PATTERN
      IFLAG='NONS'
      IF(IPATT.EQ.'SOLI')IFLAG='SOLI'
      IF(IPATT.EQ.'FILL')IFLAG='SOLI'
      IF(IPATT.EQ.'ON  ')IFLAG='SOLI'
      IF(IPATT.EQ.'VERT')IFLAG='SOLI'
      IF(IPATT.EQ.'V   ')IFLAG='SOLI'
      IF(IFIG.EQ.'POLY')IFLAG='NONS'
CCCCC END CHANGE
      ISUBN0='FIRE'
C
      NCSTR=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIRE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRFIRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IGUNIT
   52 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NP
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,61)IFIG
   61 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IPATT,JPATT
   62 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IHORPA,IVERPA,IDUPPA,IDDOPA
   63 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)PXSPA2,PYSPA2
   64 FORMAT('PXSPA2,PYSPA2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)PTHICK,JTHICK,PTHIC2
   65 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOLF,JCOLF
   66 FORMAT('ICOLF,JCOLF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOLP,JCOLP
   67 FORMAT('ICOLP,JCOLP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IMANUF,IMODEL
   68 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
CCCCC AUGUST 1992.  SET ICOL TO ICOLP FOR GRDRBP (AFFECTS COLOR
CCCCC DEVICES WHEN DOING A PATTERN FILL, E.G., 'HORI').
      ICOL=ICOLP
      IF(IPATT.EQ.'SOLI')ICOL=ICOLF
      IF(IPATT.EQ.'FILL')ICOL=ICOLF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4027')GOTO1200
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGM')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               **************************************************************
C               **  STEP 11--                                               **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES    **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)        **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1100 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIENTATION)
      IF(NUMVPP.GE.3000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               **************************************************************
C               **  STEP 12--                                               **
C               **  TREAT THE TEKTRONIX 4027 CASE                           **
C               **  (COLOR RASTER DEVICE).                                  **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1200 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO1220
      IF(IPATT.EQ.'EMPT')GOTO1290
      IF(IPATT.EQ.'BLAN')GOTO1290
      IF(IPATT.EQ.'    ')GOTO1290
      IF(IPATT.EQ.'NONE')GOTO1290
      IF(IPATT.EQ.'SOLI')GOTO1210
      IF(IPATT.EQ.'FILL')GOTO1210
      GOTO1220
C
 1210 CONTINUE
      IF(NP.LE.0)GOTO1219
      DO1211I=1,NP
      CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
 1211 CONTINUE
CCCCC WRITE(IGUNIT,1212)(IX(I),IY(I),I=1,NP)
C1212 FORMAT('!POL ',20I6)
      ICSTR(1:5)='!POL '
      NCSTR=5
      NCHTOT=6
      DO1215I=1,NP
      CALL GRTRIN(IX(I),NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY(I),NCHTOT,ICSTR,NCSTR)
 1215 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1219 CONTINUE
      GOTO1290
C
 1220 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIENTATION)
      IF(NUMVPP.GE.3000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO1290
C
 1290 CONTINUE
      GOTO9000
C
C               ****************************************************************
C               **  STEP 13--                                                 **
C               **  TREAT THE TEKTRONIX 4105 CASE                             **
C               **  (COLOR RASTER DEVICE)                                     **
C               **  SWITCH TO DIALOGUE MODE (AN UNDOCUMENTED NECESSITY!)      **
C               **  WRITE OUT ESCAPE LP FIRST-POINT,DRAW-BOUNDARY (PAGE 5-7)  **
C               **  LIST OUT BOUNDARY POINTS WITH DRAW COMMAND (PAGE 5-7)     **
C               **  WRITE OUT ESCAPE LE  TO FINISH PANEL DEFINITION           **
C               **  SWITCH BACK TO GRAPHICS MODE (AGAIN, UNDOCUMENTED!)       **
C               **  REFERENCE--PAGES 5-7, 5-17, 5-32                          **
C               **  REFERENCE--PAGE 5-9                                       **
C               ****************************************************************
C
 1300 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO1320
      IF(IPATT.EQ.'EMPT')GOTO1390
      IF(IPATT.EQ.'BLAN')GOTO1390
      IF(IPATT.EQ.'    ')GOTO1390
      IF(IPATT.EQ.'NONE')GOTO1390
      IF(IPATT.EQ.'SOLI')GOTO1310
      IF(IPATT.EQ.'FILL')GOTO1310
      GOTO1320
C
 1310 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIENTATION)
      IF(NUMVPP.GE.3000)IFACTO=1
C
      IF(JCOLF.EQ.0)JCOL2=48
      IF(JCOLF.NE.0)JCOL2=JCOLF+32
CCCCC ICOL2=CHAR(JCOL2)
      CALL DPCONA(JCOL2,ICOL2)
CCCCC WRITE(IGUNIT,1311)IESCC,ICOL2
C1311 FORMAT(A1,'MP',A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='MP'
      ICSTR(4:4)=ICOL2
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,1312)IESCC
C1312 FORMAT(A1,'KA1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='KA1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='LP'
      NCSTR=3
      IF(NP.LE.0)GOTO1390
      I=1
      CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
      CALL TKTRPT(IX(I),IY(I),IFACTO,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='0'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='LG'
      IF(NP.LE.1)GOTO1316
      DO1315I=2,NP
      NCSTR=3
      CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
      CALL TKTRPT(IX(I),IY(I),IFACTO,ICSTR,NCSTR,ISUBN0)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1315 CONTINUE
 1316 CONTINUE
C
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='LE'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,1318)IESCC
C1318 FORMAT(A1,'KA0')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='KA0'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO1390
C
 1320 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIENTATION)
      IF(NUMVPP.GE.3000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO1390
C
 1390 CONTINUE
      GOTO9000
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2100 CONTINUE
      IFACTO=(-999)
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      IFACTO=(-999)
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-10, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      IFACTO=(-999)
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE HEWLETT-PACKARD PCL           CASE    **
C               **  (LASER PRINTERS, E.G. THE LASER JET             **
C               **  DO THE FOLLOWING FOR A SOLID OR PATTERN FILL OF **
C               **  RECTANGULAR REGION                              **
C               **  ESCC *c0P          - DO A SOLID FILL            **
C               **  ESCC *c2P          - DO A PATTERN FILL          **
C               **  ESCC *c#G          - DEFINE THE PATTERN FILL    **
C               **  ESCC *c#A          - RECTANGLE WIDTH IN DOTS    **
C               **  ESCC *c#B          - RECTANGLE HEIGHT IN DOTS   **
C               **  REFERENCE--HP LASERJET SERIES II TECHNICAL      **
C               **             REFERENCE MANUAL                     **
C               **             CHAPTER ON RASTER GRAPHICS           **
C               ******************************************************
C
 2600 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('FILL REGION')
C  DECEMBER 1987: ADD "SET PATTERN REGION HORIZIONTAL SPACING" AND
C "SET PATTERN REGION VERTICAL SPACING" AND
C "SET PATTERN LINE" COMMANDS
C  JANUARY 1988: ADD A SOFTWARE SETTABLE SWITCH.  EITHER PRINT OUT
C  THE DESCRIPTION OF THE PATTERN (E.G. "HORIZONTAL") OR HAVE DATAPLOT
C  DO THE FILL (I.E., THE "MOVE TO" AND "DRAW TO" COMMANDS).
C
      IF(IRFLSW.EQ.'ON')GOTO3190
      IF(IFLAG.EQ.'NONS')GOTO3190
C
      ICSTR(1:11)='SET FILL ON'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:38)='SET PATTERN REGION HORIZONTAL SPACING '
      NCSTR=38
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PXSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:36)='SET PATTERN REGION VERTICAL SPACING '
      NCSTR=36
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PYSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:24)='SET PATTERN REGION LINE '
      ICSTR(25:28)=IPATT2
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  END CHANGE
      ICSTR(1:11)='FILL REGION'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.0)GOTO3129
      DO3120I=1,NP
CCCCC WRITE(IGUNIT,3121)PX(I),PY(I)
C3121 FORMAT(F10.5,2X,F10.5)
      NCSTR=0
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(11:12)='  '
      NCSTR=12
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3120 CONTINUE
 3129 CONTINUE
CCCCC WRITE(IGUNIT,3131)
C3131 FORMAT('END OF FILL REGION')
      ICSTR(1:18)='END OF FILL REGION'
      NCSTR=18
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 3190 CONTINUE
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
C  DECEMBER 1987: ADD "SET PATTERN REGION HORIZIONTAL SPACING" AND
C "SET PATTERN REGION VERTICAL SPACING" AND
C "SET PATTERN LINE" COMMANDS
C  JANUARY 1988: ADD A SOFTWARE SETTABLE SWITCH.  EITHER PRINT OUT
C  THE DESCRIPTION OF THE PATTERN (E.G. "HORIZONTAL") OR HAVE DATAPLOT
C  DO THE FILL (I.E., THE "MOVE TO" AND "DRQW TO" COMMANDS).
C
      IF(IRFLSW.EQ.'ON')GOTO3290
      IF(IFLAG.EQ.'NONS')GOTO3290
C
      ICSTR(1:7)='SEFI ON'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:31)='SEPA REGION HORIZONTAL SPACING '
      NCSTR=31
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PXSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:29)='SEPA REGION VERTICAL SPACING '
      NCSTR=29
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PYSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='SEPA REGION LINE '
      ICSTR(18:21)=IPATT2
      NCSTR=21
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  END CHANGE
      ICSTR(1:4)='FIRE'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NP.LE.0)GOTO3229
C
C  DECEMBER 1997.  FOR GUI, CODE POINTS DIFFERENTLY.
C
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
      DO3220I=1,NP
      NCSTR=0
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(11:12)='  '
      NCSTR=12
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3220 CONTINUE
      GOTO3229
C
 3250 CONTINUE
      DO3270I=1,NP
      NCSTR=0
      NCHTOT=IGENFA+3
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      IPXTMP=INT(AX*10.**IGENFA+0.5)
      IPYTMP=INT(AY*10.**IGENFA+0.5)
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3270 CONTINUE
C
 3229 CONTINUE
      ICSTR(1:4)='ENFI'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 3290 CONTINUE
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ***************************************************
C               **  STEP 33--                                    **
C               **  TREAT THE GENERAL (CGM               ) CASE  **
C               ***************************************************
C
 3300 CONTINUE
C
      IF(IRFLSW.EQ.'ON')GOTO3390
      IF(IFLAG.EQ.'NONS')GOTO3390
C
      IF(IPATT.EQ.'EMPT')GOTO3390
      IF(IPATT.EQ.'BLAN')GOTO3390
      IF(IPATT.EQ.'    ')GOTO3390
      IF(IPATT.EQ.'NONE')GOTO3390
      IF(IPATT.EQ.'SOLI')GOTO3310
      IF(IPATT.EQ.'FILL')GOTO3310
      GOTO3310
C
 3310 CONTINUE
      ICSTR(1:7)='POLYGON'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCHTOT=10
      NCHDEC=5
      DO 3340I=1,NP
      NCSTR=0
      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(11:12)=', '
      NCSTR=12
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(23:23)=','
      IF(I.EQ.NP)ICSTR(23:23)=';'
      NCSTR=23
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3340 CONTINUE
C
      GOTO9000
C
 3390 CONTINUE
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE GENERAL (CGM BINARY        ) CASE  **
C               ***************************************************
C
 3400 CONTINUE
C
      IF(IRFLSW.EQ.'ON')GOTO3490
      IF(IFLAG.EQ.'NONS')GOTO3490
C
      IF(IPATT.EQ.'EMPT')GOTO3490
      IF(IPATT.EQ.'BLAN')GOTO3490
      IF(IPATT.EQ.'    ')GOTO3490
      IF(IPATT.EQ.'NONE')GOTO3490
      IF(IPATT.EQ.'SOLI')GOTO3410
      IF(IPATT.EQ.'FILL')GOTO3410
      GOTO3410
C
 3410 CONTINUE
 3440 CONTINUE
      GOTO9000
C
 3490 CONTINUE
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--CALCOMP LIBRARY ROUTINE              **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRFIRE TO FILL REG  CALCOMP DEVICE')
CCCCC ICSTR(1:49)='FIX SUBROUTINE GRFIRE TO FILL REG  CALCOMP DEVICE'
CCCCC NCSTR=49
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC GOTO9000
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(IPATT.EQ.'EMPT')GOTO4690
      IF(IPATT.EQ.'BLAN')GOTO4690
      IF(IPATT.EQ.'    ')GOTO4690
      IF(IPATT.EQ.'NONE')GOTO4690
      IF(IPATT.EQ.'SOLI')GOTO4610
      IF(IPATT.EQ.'FILL')GOTO4610
      GOTO4620
 4610 CONTINUE
      CALL NEWPEN(JCOLF)
      ILAHCC=JCOLF
      CALL FILL(NP,PX,PY)
 4620 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
C
 4690 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
CCCCC IF(IQWNFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO4730
      IF(IFLAG.EQ.'NONS')GOTO4720
      IF(IPATT.EQ.'EMPT')GOTO4790
      IF(IPATT.EQ.'BLAN')GOTO4790
      IF(IPATT.EQ.'    ')GOTO4790
      IF(IPATT.EQ.'NONE')GOTO4790
CCCCC CURRENTLY, DO ALL FILLS IN SOFTWARE.
      IF(IPATT.EQ.'SOLI')GOTO4730
      IF(IPATT.EQ.'FILL')GOTO4730
      GOTO4720
C
 4710 CONTINUE
      GOTO9000
C
CCCCC HATCH FILL DONE IN SOFTWARE
 4720 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')THEN
        CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,
     1              IPATT2,PTHICK,ICOL)
      ELSEIF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
 4730 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
 4790 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO4820
      IF(IPATT.EQ.'EMPT')GOTO4890
      IF(IPATT.EQ.'BLAN')GOTO4890
      IF(IPATT.EQ.'    ')GOTO4890
      IF(IPATT.EQ.'NONE')GOTO4890
      IF(IPATT.EQ.'SOLI')GOTO4810
      IF(IPATT.EQ.'FILL')GOTO4810
      GOTO4820
C
 4810 CONTINUE
      IF(IFIG.EQ.'BOX')THEN
        
        PX2(1)=PX(1)
        PY2(1)=PY(1)
        PX2(2)=PX(3)
        PY2(2)=PY(3)
        NP2=2
        CALL GLREFL(PX2,PY2,NP2)
      ELSE
        CALL GLREFL(PX,PY,NP)
      END IF
 4819 CONTINUE
      GOTO9000
C
 4820 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
 4830 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
 4890 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO4920
      IF(IPATT.EQ.'EMPT')GOTO4940
      IF(IPATT.EQ.'BLAN')GOTO4940
      IF(IPATT.EQ.'    ')GOTO4940
      IF(IPATT.EQ.'NONE')GOTO4940
      IF(IPATT.EQ.'SOLI')GOTO4910
      IF(IPATT.EQ.'FILL')GOTO4910
      GOTO4920
C
 4910 CONTINUE
      IF(NP.LE.0)GOTO4990
      ISTYLE=4
      IDENSE=0
      IANGLE=0
CINTE CALL IGrFillPattern(ISTYLE,IDENSE,IANGLE)
CINTE CALL IGrPolygonComplex(REAL(IX),REAL(IY),NP)
CINTE CALL IGrPolygonComplex(PX,PY,NP)
      GOTO 4940
C
 4920 CONTINUE
      IFACTO=4
      IF(NUMHPP.GE.4000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO4940
C
 4940 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO4970
      IF(IPATT.EQ.'EMPT')GOTO4990
      IF(IPATT.EQ.'BLAN')GOTO4990
      IF(IPATT.EQ.'    ')GOTO4990
      IF(IPATT.EQ.'NONE')GOTO4990
      IF(IPATT.EQ.'SOLI')GOTO4960
      IF(IPATT.EQ.'FILL')GOTO4960
      GOTO4970
C
 4960 CONTINUE
      IF(NP.LE.2)GOTO4990
      ISTYLE=4
      IDENSE=0
      IANGLE=0
CWINT CALL IGrFillPattern(ISTYLE,IDENSE,IANGLE)
CWINT CALL IGrPolygonComplex(PX,PY,NP)
      GOTO 4990
C
 4970 CONTINUE
      IFACTO=4
      IF(NUMHPP.GE.4000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO4990
C
 4990 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY ROUTINE                     **
C               ******************************************************
C
 5100 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO FILL REG--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRFIRE TO FILL REG  RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRFIRE TO FILL REG  RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ****************************************************
C               **  STEP 66--                                     **
C               **  TREAT THE SUN - WRITTEN BY BILL ANDERSON      **
C               ****************************************************
C
 6600 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO6620
      IF(IPATT.EQ.'EMPT')GOTO6690
      IF(IPATT.EQ.'BLAN')GOTO6690
      IF(IPATT.EQ.'    ')GOTO6690
      IF(IPATT.EQ.'NONE')GOTO6690
      IF(IPATT.EQ.'SOLI')GOTO6610
      IF(IPATT.EQ.'FILL')GOTO6610
      GOTO6620
C
 6610 CONTINUE
      IF(NP.LE.0)GOTO6690
      DO6611I=1,NP
      CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
 6611 CONTINUE
CSUN  CALL cfflcolor(JCOLF)
CSUN  CALL cfperimcolor(JCOLP)
CSUN  CALL cfpolygon(IX,IY,NP)
      GOTO 6690
C
 6620 CONTINUE
      IFACTO=4
      IF(NUMHPP.GE.4000)IFACTO=1
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO6690
C
 6690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO FILL REG--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRFIRE TO FILL REG  XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRFIRE TO FILL REG  XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC REGIS      CASE                   **
C               **  TO FILL REG--                                   **
C               **  WRITE OUT AN                                    **
C               **    P[IX,IY]  - MOVE TO FIRST POINT               **
C               **    W(S1)     - ENABLE SHADING (SOLID FILL)       **
C               **    V[IX(I),IY(I)] - DRAW VECTOR ON REGION TO BE  **
C               **                     FILLED                       **
C               **    W(S0)     - DISABLE SHADING
C               **  (NOT DONE)                                      **
C               **  REFERENCE--VT 240 PROGRAMMER REFERENCE MANUAL   **
C               **             DEC (OCTOBER, 1983 EDITION)          **
C               **             PAGES 5-90 THRU 5-103                **
C               ******************************************************
C
 8100 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO8120
      IF(IPATT.EQ.'EMPT')GOTO8190
      IF(IPATT.EQ.'BLAN')GOTO8190
      IF(IPATT.EQ.'    ')GOTO8190
      IF(IPATT.EQ.'NONE')GOTO8190
      IF(IPATT.EQ.'SOLI')GOTO8110
      IF(IPATT.EQ.'FILL')GOTO8110
      GOTO8120
C
 8110 CONTINUE
      IF(NP.LE.0)GOTO8119
      DO8111I=1,NP
      CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
 8111 CONTINUE
      ICSTR(1:2)='P['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX(1),NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY(1),NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='W(S1)'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO8115I=1,NP
      ICSTR(1:2)='V['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX(I),NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY(I),NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8115 CONTINUE
      ICSTR(1:5)='W(S0)'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8119 CONTINUE
      GOTO8190
C
 8120 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO8190
C
 8190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT           CASE             **
C               **  TO FILL REG--                                   **
C               **  <SHAD> SETGREY - SET GREY SCALE FOR SOLID FILL  **
C               **  <X Y COOR PAIRS> FILL                           **
C               **  REFERENCE--POSTSCRIPT LANGUAGE COOKBOOK AND     **
C               **             TUTORIAL FROM ADOBE SYSTEMS          **
C               **             PAGES XX AND XX                      **
C               **  MODIFIED JANUARY, 1990 TO SUPPORT COLOR.  IF    **
C               **  COLOR TURNED ON, COLOR FOR REGIONS SET IN       **
C               **  GRSECO, IF NOT THEN USE GREY SCALE FOR SOLID    **
C               **  FILL REGIONS.                                   **
C               ******************************************************
C
 8600 CONTINUE
CCCCC IF(IFLAG.EQ.'NONS')GOTO8620
CCCCC JUNE 1994.  ADD FOLLOWING LINE
      IF(IPSTFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO8630
      IF(IPATT.EQ.'EMPT')GOTO8690
      IF(IPATT.EQ.'BLAN')GOTO8690
      IF(IPATT.EQ.'    ')GOTO8690
      IF(IPATT.EQ.'NONE')GOTO8690
      IF(IPATT.EQ.'SOLI')GOTO8610
      IF(IPATT.EQ.'FILL')GOTO8610
      GOTO8620
C
 8610 CONTINUE
      IF(NP.LE.3)GOTO8619
C  JANUARY, 1990.  COLOR TABLES CHANGED WHEN ADDED SUPPORT FOR COLOR.
CCCCC AINC=1./7.
CCCCC AGREY=REAL(JCOLF)*AINC
CCCCC IF(AGREY.LT.0.)AGREY=0.
CCCCC IF(AGREY.GT.1.)AGREY=1.
C
C  AUGUST 1992.  COLOR AND GRAY SCALE NOW HANDLED IN A MORE DEVICE
C  INDEPENDENT MANNER IN GRTRCO, GRSECO.  COMMENT OUT FOLLOWING
C  BLOCK OF CODE.  ALSO, SINCE NOW A WAY TO SPECIFICALLY ASK FOR
C  GRAY SCALE, DO NOT MAP COLORS TO GRAY SCALE ON BLACK AND WHITE
C  DEVICES.
C
CCCCC IF(IGCOLO.EQ.'ON')GOTO8615
CCCCC AGREY=0.
CCCCC IF(JCOLF.EQ.0)AGREY=0.
CCCCC IF(JCOLF.EQ.1)AGREY=0.4
CCCCC IF(JCOLF.EQ.2)AGREY=0.5
CCCCC IF(JCOLF.EQ.3)AGREY=0.8
CCCCC IF(JCOLF.EQ.4)AGREY=0.3
CCCCC IF(JCOLF.EQ.5)AGREY=0.1
CCCCC IF(JCOLF.EQ.6)AGREY=0.6
CCCCC IF(JCOLF.EQ.7)AGREY=1.0
CCCCC IF(JCOLF.EQ.8)AGREY=0.7
CCCCC IF(JCOLF.EQ.9)AGREY=0.5
CCCCC IF(JCOLF.EQ.10)AGREY=0.3
CCCCC IF(JCOLF.EQ.11)AGREY=0.3
CCCCC IF(JCOLF.EQ.12)AGREY=0.1
CCCCC IF(JCOLF.EQ.13)AGREY=0.1
CCCCC IF(JCOLF.EQ.14)AGREY=0.2
CCCCC IF(JCOLF.EQ.15)AGREY=0.9
CCCCC NCSTR=0
CCCCC NCHTOT=10
CCCCC NCHDEC=5
CCCCC CALL GRTRRE(AGREY,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC ICSTR(11:26)=' setgray newpath'
CCCCC NCSTR=26
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C8615 CONTINUE
      NCHTOT=5
      NCSTR=0
      CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' m'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      DO8611I=2,NP
      NCSTR=0
      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:6)=' '
      NCSTR=6
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:13)=' l'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8611 CONTINUE
C  JANUARY, 1990.  FOLLOWING 2 LINES CHANGED.  DEPENDS ON WHETHER ASSUMING
C  COLOR OR BLACK AND WHITE.
CCCCC ICSTR(1:25)='closepath fill 0. setgray'
CCCCC NCSTR=25
      IF(IGCOLO.EQ.'ON')THEN
        ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
        NCSTR=35
      ELSE
        ICSTR(1:25)='closepath fill 0. setgray'
        NCSTR=25
      ENDIF
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8619 CONTINUE
      GOTO8690
C
 8620 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO8690
C
 8630 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
 8690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC           CASE                   **
C               **  TO FILL REG--                                   **
C               **  WRITE OUT AN ^LAFhhhhhvvvvv20^G                 **
C               **  IF PICK POINT IN MIDDLE OF REGION, WILL HARDWARE**
C               **  FILL TO LINES FORMING REGION AROUND THAT POINT. **
C               **  NOTE THAT FOR DATAPLOT, THE REGION BORDER MAY   **
C               **  BE BLANK, WHICH CAN CAUSE DISASTOROUS RESULTS,  **
C               **  ALSO DEPENDS ON BORDER BEING DRAW FIRST, WHICH  **
C               **  IS NOT GARUNTEED IN DATAPLOT                    **
C               **  THERFORE DO A SOFTWARE REGION FILL              **
C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
C               **             CHAPTER 8                            **
C               ******************************************************
C
 9100 CONTINUE
      IF(IPATT.EQ.'EMPT')GOTO9190
      IF(IPATT.EQ.'BLAN')GOTO9190
      IF(IPATT.EQ.'    ')GOTO9190
      IF(IPATT.EQ.'NONE')GOTO9190
      IF(IPATT.EQ.'SOLI')GOTO9120
      IF(IPATT.EQ.'FILL')GOTO9120
      GOTO9120
C
C9110 CONTINUE
CCCCC IF(NP.LE.0)GOTO9119
CCCCC DO9111I=1,NP
CCCCC CALL QUICPT(PX(I),PY(I),IX(I),IY(I),ISUBN0)
CCCCC IY(I)=100.-IY(I)
C9111 CONTINUE
CCCCC ICSTR(1:1)=ICARAT
CCCCC ICSTR(2:4)='LAF'
CCCCC NCSTR=4
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IX(1),NCHTOT,ICSTR,NCSTR)
CCCCC CALL GRTRIN(IY(1),NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(15:16)='20'
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCST:NCSTR)=ICARAT
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='G'
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C9119 CONTINUE
CCCCC GOTO9190
C
 9120 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
      GOTO9190
C
 9190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  SOLID FILLS DONE BY XLIB, PATTERNED FILLS WITH  **
C               **  SOFTWARE                                        **
C               ******************************************************
C
 9600 CONTINUE
CCCCC JUNE 1994.  FOLLOWING LINE ADDED
      IF(IX11FS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO9630
      IF(IFLAG.EQ.'NONS')GOTO9620
      IF(IPATT.EQ.'EMPT')GOTO9690
      IF(IPATT.EQ.'BLAN')GOTO9690
      IF(IPATT.EQ.'    ')GOTO9690
      IF(IPATT.EQ.'NONE')GOTO9690
      IF(IPATT.EQ.'SOLI')GOTO9610
      IF(IPATT.EQ.'FILL')GOTO9610
      GOTO9620
C
 9610 CONTINUE
      IF(NP.LE.3)GOTO9619
      CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
      IF(IFIG.EQ.'BOX')THEN
        CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
        NTEMP=2
      ELSE
        DO9611I=2,NP
        CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
 9611   CONTINUE
        NTEMP=NP
      END IF
      CALL XREGFL(IX,IY,NTEMP)
 9619 CONTINUE
      GOTO9000
C
 9620 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
 9630 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
 9690 CONTINUE
C
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 71.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 122.                       **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 13-16, 39-50**
C               *************************************************
C
10000 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO10620
      IF(IPATT.EQ.'EMPT')GOTO10690
      IF(IPATT.EQ.'BLAN')GOTO10690
      IF(IPATT.EQ.'    ')GOTO10690
      IF(IPATT.EQ.'NONE')GOTO10690
      IF(IPATT.EQ.'SOLI')GOTO10610
      IF(IPATT.EQ.'FILL')GOTO10610
      GOTO10620
C
10610 CONTINUE
      IF(NP.LE.3)GOTO10619
      CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
      IF(IFIG.EQ.'BOX')THEN
         CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
         NTEMP=2
      ELSE
         DO10611I=2,NP
         CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
10611    CONTINUE
         NTEMP=NP
      END IF
      CALL TCFIRE(IX,IY,NTEMP)
10619 CONTINUE
      GOTO9000
C
10620 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
10690 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      IF(IFLAG.EQ.'NONS')GOTO11620
      IF(IPATT.EQ.'EMPT')GOTO11690
      IF(IPATT.EQ.'BLAN')GOTO11690
      IF(IPATT.EQ.'    ')GOTO11690
      IF(IPATT.EQ.'NONE')GOTO11690
      IF(IPATT.EQ.'SOLI')GOTO11610
      IF(IPATT.EQ.'FILL')GOTO11610
      GOTO11620
C
11610 CONTINUE
      IF(NP.LE.3)GOTO11619
CGKS  CALL GFA(PX,PY,NTEMP)
11619 CONTINUE
      GOTO9000
C
11620 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
11690 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
CCCCC GD SOLID FILL FOR NON-RECTANGULAR REGIONS BLOWS UP FOR
CCCCC PIE CHARTS (MAYBE OTHERS).  MAKE SWITCHABLE, BUT FOR NOW
CCCCC SIMPLY DO NON-RECTANGULAR SOLID FILLS IN SOFTWARE.
CCCCC IF(IGDFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO12030
      IF(IFIG.NE.'BOX')GOTO12030
C
      IF(IFLAG.EQ.'NONS')GOTO12020
      IF(IPATT.EQ.'EMPT')GOTO12090
      IF(IPATT.EQ.'BLAN')GOTO12090
      IF(IPATT.EQ.'    ')GOTO12090
      IF(IPATT.EQ.'NONE')GOTO12090
      IF(IPATT.EQ.'SOLI')GOTO12010
      IF(IPATT.EQ.'FILL')GOTO12010
      GOTO12020
C
12010 CONTINUE
      IF(NP.LE.3)GOTO12019
      CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
      IF(IFIG.EQ.'BOX')THEN
        CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
        NTEMP=2
      ELSE
        DO12011I=2,MAX(100,NP)
        CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
12011   CONTINUE
        NTEMP=NP
      END IF
      CALL GDRGFL(IX,IY,NTEMP,JCOLF)
12019 CONTINUE
      GOTO9000
C
12020 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
12030 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
12090 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
C
CCCCC IF(IAQUFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO13530
      IF(IFIG.NE.'BOX')GOTO13530
C
      IF(IFLAG.EQ.'NONS')GOTO13520
      IF(IPATT.EQ.'EMPT')GOTO13590
      IF(IPATT.EQ.'BLAN')GOTO13590
      IF(IPATT.EQ.'    ')GOTO13590
      IF(IPATT.EQ.'NONE')GOTO13590
CCCCC IF(IPATT.EQ.'SOLI')GOTO13510
CCCCC IF(IPATT.EQ.'FILL')GOTO13510
      IF(IPATT.EQ.'SOLI')GOTO13510
      IF(IPATT.EQ.'FILL')GOTO13510
      GOTO13520
C
13510 CONTINUE
      IF(NP.LE.3)GOTO13519
      CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
      IF(IFIG.EQ.'BOX')THEN
        CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
        NTEMP=2
      ELSE
        DO13511I=2,MAX(100,NP)
        CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
13511   CONTINUE
        NTEMP=NP
      END IF
CCCCC CALL aqtAddFilledRect(AX1,AX2,AY1,AY2)
13519 CONTINUE
      GOTO9000
C
13520 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
13530 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
13590 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
C
      IF(IPATT.EQ.'EMPT')GOTO15090
      IF(IPATT.EQ.'BLAN')GOTO15090
      IF(IPATT.EQ.'NONE')GOTO15090
      IF(IPATT.EQ.'    ')GOTO15090
C
      IF(IFIG.NE.'BOX')THEN
        IF(IFLAG.EQ.'SOLI')THEN
          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1                IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
        ELSE
          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1                IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
        ENDIF
      ELSE
C
C  NOTE: THE METHOD FOR A SOLID FILLED BOX CODED BELOW DOESN'T QUITE
C        WORK.  THE colorbox BY ITSELF DOES NOT ALLOW EXPLICIT
C        SPECIFICATION OF WIDTH AND HEIGHT.  COMBINING IT WITH A
C        MAKEBOX RESULTS IN A FILL THAT EXTENDS PAST THE BORDERS OF
C        THE BOX.  SO COMMENT OUT FOR NOW AND PERFORM ALL FILLS IN
C        SOFTWARE.
C
        IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
CCCCC     IF(ILATFS.EQ.'ON')THEN
CCCCC       IF(NP.LT.3)GOTO15090
CCCCC       CALL GRTRSD(PX(1),PY(1),IX1,IY1,ISUBN0)
CCCCC       CALL GRTRSD(PX(3),PY(3),IX2,IY2,ISUBN0)
CCCCC       IWID=IX2-IX1
CCCCC       IHT=IY2-IY1
CCCCC       ICSTR(1:1)=IBASLC
CCCCC       ICSTR(2:5)='put('
CCCCC       NCSTR=5
CCCCC       NCHTOT=5
CCCCC       CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR)=','
CCCCC       CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR+2)='){'
CCCCC       NCSTR=NCSTR+3
CCCCC       ICSTR(NCSTR:NCSTR)=IBASLC
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR+7)='colorbox'
CCCCC       NCSTR=NCSTR+8
CCCCC       ICSTR(NCSTR:NCSTR+6)='{    }{'
CCCCC       ICSTR(NCSTR+1:NCSTR+4)=ICOLF(1:4)
CCCCC       NCSTR=NCSTR+7
CCCCC       ICSTR(NCSTR:NCSTR)=IBASLC
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR+7)='makebox('
CCCCC       NCSTR=NCSTR+7
CCCCC       CALL GRTRIN(IWID,NCHTOT,ICSTR,NCSTR)
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR)=','
CCCCC       CALL GRTRIN(IHT,NCHTOT,ICSTR,NCSTR)
CCCCC       NCSTR=NCSTR+1
CCCCC       ICSTR(NCSTR:NCSTR+5)='){ }}}'
CCCCC       NCSTR=NCSTR+5
CCCCC       CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC     ELSE
            IFACTO=-999
            CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1                  IHORPA,IVERPA,IDUPPA,IDDOPA,
     1                  IPATT2,PTHICK,ICOL)
CCCCC     ENDIF
        ELSE
          IFACTO=-999
          CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1                IHORPA,IVERPA,IDUPPA,IDDOPA,
     1                IPATT2,PTHICK,ICOL)
        ENDIF
      ENDIF
C
15090 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABE VECTOR GRAPHICS) DRIVER  **
C               ******************************************************
C
16000 CONTINUE
C
      CALL DPCONA(34,IQUOTE)
C
      IF(ISVGFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO16030
      IF(IFLAG.EQ.'NONS')GOTO16020
      IF(IPATT.EQ.'EMPT')GOTO16090
      IF(IPATT.EQ.'BLAN')GOTO16090
      IF(IPATT.EQ.'    ')GOTO16090
      IF(IPATT.EQ.'NONE')GOTO16090
      IF(IPATT.EQ.'SOLI')GOTO16010
      IF(IPATT.EQ.'FILL')GOTO16010
      GOTO16020
C
16010 CONTINUE
      IF(NP.LE.3)GOTO16019
      CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
      IF(IFIG.EQ.'BOX')THEN
        CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
        IF(IX(1).LE.IX(2))THEN
          IXSTRT=IX(1)
          IXSTOP=IX(2)
        ELSE
          IXSTRT=IX(2)
          IXSTOP=IX(1)
        ENDIF
        IF(IY(1).LE.IY(2))THEN
          IYSTRT=IY(1)
          IYSTOP=IY(2)
        ELSE
          IYSTRT=IY(2)
          IYSTOP=IY(1)
        ENDIF
        IWID=IXSTOP-IXSTRT+1
        IHEIG=IYSTOP-IYSTRT+1
C
        ICSTR(1:11)='   <rect x='
        ICSTR(12:12)=IQUOTE
        NCSTR=12
        NCHTOT=5
        CALL GRTRIN(IXSTRT,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+2)=' y='
        NCSTR=NCSTR+3
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IYSTRT,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:15)='         width='
        ICSTR(16:16)=IQUOTE
        NCSTR=16
        CALL GRTRIN(IWID,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+7)=' height='
        NCSTR=NCSTR+8
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRTRIN(IHEIG,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:17)='           style='
        ICSTR(18:18)=IQUOTE
        ICSTR(19:31)='stroke:none; '
        NCSTR=-31
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:19)='             fill:#'
        NCSTR=19
        NCHTOT=2
        JTEMP=JCOLF
        IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+2
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:7)='     />'
        NCSTR=-7
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ELSE
        ICSTR(1:11)='   <polygon'
        NCSTR=-11
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:17)='           style='
        ICSTR(18:18)=IQUOTE
        ICSTR(19:31)='stroke:none; '
        NCSTR=-31
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:19)='             fill:#'
        NCSTR=19
        NCHTOT=2
        JTEMP=JCOLF
        IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+2
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:13)='      points='
        ICSTR(14:14)=IQUOTE
        NCSTR=-14
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCHTOT=5
C
        NCSTR=0
        DO16011I=1,NP
          IF(NCSTR.GT.80)THEN
            NCSTR=-NCSTR
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
            NCSTR=3
            ICSTR(1:NCSTR)='   '
          ENDIF
          CALL GRTRSD(PX(I),PY(I),IXTEMP,IYTEMP,ISUBN0)
          CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=','
          CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          IF(NCSTR.LE.80)GOTO16011
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          NCSTR=3
          ICSTR(1:NCSTR)='   '
16011   CONTINUE
C
        IF(NCSTR.GT.3)THEN
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
C
        ICSTR(1:3)='   '
        ICSTR(4:4)=IQUOTE
        ICSTR(5:6)='/>'
        NCSTR=-6
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      END IF
16019 CONTINUE
      GOTO9000
C
16020 CONTINUE
      IFACTO=-999
      IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1IHORPA,IVERPA,IDUPPA,IDDOPA,
     1IPATT2,PTHICK,ICOL)
      IF(IFIG.NE.'BOX')THEN
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
      GOTO9000
C
16030 CONTINUE
      IF(IFLAG.EQ.'SOLI')THEN
        CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1             IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
      ELSE
        CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
     1            IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
      ENDIF
C
16090 CONTINUE
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'FIRE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRFIRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IGUNIT
 9012 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      DO9017I=1,NP
      WRITE(ICOUT,9018)IX(I),IY(I)
 9018 FORMAT('IX(I),IY(I) = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
C
      WRITE(ICOUT,9021)IFIG
 9021 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IPATT,JPATT
 9022 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IHORPA,IVERPA,IDUPPA,IDDOPA
 9023 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)PXSPA2,PYSPA2
 9024 FORMAT('PXSPA2,PYSPA2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)PTHICK,JTHICK,PTHIC2
 9025 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOLF,JCOLF
 9026 FORMAT('ICOLF,JCOLF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOLP,JCOLP
 9027 FORMAT('ICOLP,JCOLP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IMANUF,IMODEL
 9028 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)NCSTR
 9033 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9037
      DO9035I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9036)I,ICSTR(I:I),IASCNE
 9036 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9037 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRINDE
C
C     PURPOSE--INITIALIZE A SPECIFIC GRAPHICS DEVICE
C              TO DEFAULT POWER-ON CONDITIONS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MAY      1989. CORRECT POSTSCRIPT SCALING (ALAN)
C     UPDATED         --MARCH    1990. ADD X11 DRIVER
C     UPDATED         --APRIL    1990. SUN PATCH (BILL ANDERSON)
C     UPDATED         --MAY      1990. ADD "SC" COMMAND TO HP-GL (ALAN)
C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN HECKERT)
C     UPDATED         --JANUARY, 1991. REGIS (DEFINE MAX COLORS) (ALAN)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --MAY      1991. INCREASE CHARACTER INDICES
C     UPDATED         --OCTOBER  1991. POSTSCRIPT UPDATES (ALAN)
C     UPDATED         --DECEMBER 1991. POSTSCRIPT BUG (ALAN)
C     UPDATED         --AUGUST   1992. CGM COLOR TABLE (ALAN)
C     UPDATED         --AUGUST   1992. HPGL FOR LASERJET III (ALAN)
C     UPDATED         --JANUARY  1993. FIX POSTSCRIPT HEADER (HAD
C                                      PROBLEM WITH FRAMEMAKER) (ALAN)
C     UPDATED         --MAY      1995. PASS MODEL NUMBER (WINDOW IDENT)
C                                      FOR X11 (USED BY FRONT-END)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. WININTERACTOR CODE
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --NOVEMBER 2002. SUPPORT FOR QWIN "-TILE" OPTION
C     UPDATED         --JANUARY  2003. SUPPORT FOR POSTSCRIPT SET
C                                      BOUNDING BOX OPTION
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT THE LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
C
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
C
CWINT TYPE(WIN_STYLE)     :: WINDOW
C
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF TYPE (QWINFO)  WINFO
CQWVF TYPE (FONTINFO) MSFONT
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
CCCCC NOVEMBER 2002.  ADD FOLLOWING TWO LINES
CQWVF CHARACTER*4 IQWNTL
CQWVF COMMON/QUICKW4/IQWNTL
C
      CHARACTER*130 ICSTR
      CHARACTER*130 IATEMP
      CHARACTER*80 ISTEMP
      CHARACTER*4 ISUBN0
      CHARACTER*1 IQUOTE
      CHARACTER*1 ICARAT
      CHARACTER*2 ICJUNK
C  AUGUST 1992.  ADD FOLLOWING 2 LINES
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C  MAY 1995.  ADD FOLLOWING 3 LINES
      CHARACTER*8 CTEMP
      CHARACTER*1 IA
      INTEGER IWIND(8)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOF2.INC'
      CHARACTER*200 CMAPNM
      INTEGER RETNED,DD,CMAPSZ
CSUN  CHARACTER*200 SCNNAM,WINNAM,PTR
CSUN  INTEGER WINDFD,FLAGS,NOARGS
      INTEGER RD(8),GN(8),BE(8)
      INTEGER IADE(21)
CCCCC SOME DEVICES (SVG IN PARTICULAR) MAY NEED BACKGROUND COLOR
CCCCC AT INITIALIZATION.
C
      CHARACTER*4 IERASW
      CHARACTER*4 IBELSW
      CHARACTER*4 ISORSW
      CHARACTER*4 ICOPSW
      CHARACTER*4 IPENSW
      CHARACTER*4 IBACCO
      CHARACTER*4 IMARCO
      CHARACTER*4 IANISW
      CHARACTER*4 IDEFXC
      CHARACTER*4 IDEFBK
      CHARACTER*4 IDEFMC
      CHARACTER*4 IDEPEC
      CHARACTER*4 ISEQSW
      CHARACTER*4 IFENSW
      CHARACTER*4 INEGSW
      CHARACTER*4 IDEFMA
      CHARACTER*4 IDEFMO
      CHARACTER*4 IDEFM2
      CHARACTER*4 IDEFM3
      CHARACTER*4 IDEFPO
      CHARACTER*4 IDEFCN
      CHARACTER*4 IDEFDC
      CHARACTER*4 IDEFTU
      COMMON /CMISC/
     1IERASW,IBELSW,ISORSW,ICOPSW,
     1IPENSW,
     1IBACCO,IMARCO,IANISW,
     1IDEFXC,IDEFBK,IDEFMC,IDEPEC,
     1ISEQSW,
     1IFENSW,
     1INEGSW,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,
     1IDEFTU
C
      CHARACTER*4 IPSTNW
      COMMON/IPSTNW/IPSTNW
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
      CHARACTER*4 IERRF1
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C  FOLLOWING LINE FOR X11 (MARCH, 1990)
      EXTERNAL XINIT
C  DEFINE RGB TABLES FOR CGM
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='INDE'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INDE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRINDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
   56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IOFFSV,IOFFSH
   57 FORMAT('IOFFSV,IOFFSH = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4020')GOTO1100
      IF(IMODEL.EQ.'4022')GOTO1100
      IF(IMODEL.EQ.'4025')GOTO1100
      IF(IMODEL.EQ.'4027')GOTO1100
C
      IF(IMODEL.EQ.'4105')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4109')GOTO1200
      IF(IMODEL.EQ.'4115')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4113')GOTO1200
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12010
      IF(IMODEL.EQ.'PNG ')GOTO12020
      IF(IMODEL.EQ.'WBMP')GOTO12030
      IF(IMODEL.EQ.'GIF ')GOTO12040
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ***************************************************
C               **  STEP 11--                                    **
C               **  TREAT THE TEKTRONIX 4027 CASE--              **
C               **  (A COLOR TERMINAL).                          **
C               **  4. ENTER MONITOR AREA (SO CAN                **
C               **     COMMUNICATE WITH HOST)                    **
C               **     EXCLAMATION POINT MON K  (PAGE XXX)       **
C               **  2. DEFINE WORK AREA AS TOP 32 LINES          **
C               **     AND HAVE HOST OUTPUT TO TO WORK AREA      **
C               **     WHILE LEAVING KEYBOARD OUTPUT AS IS       **
C               **     EXCLAMATION POINT WOR 32 H  (PAGE XXX)    **
C               **  3. DEFINE DIALOGUE AREA AS TOP 32 LINES      **
C               **     OF WORK AREA (PLUS A BAD SIDE-EFFECT      **
C               **     OF MOVING CURSOR INTO DIALOGUE AREA       **
C               **     THERBY PROHIBITING FURTHER COMMIUNCITION  **
C               **     TO THE HOST SINCE CAN ONLY COMMUNICATE    **
C               **     WITH HOST IF IN MONITOR AREA.)            **
C               **     EXCLAMATION POINT GRA 1,32   (PAGE XXX)   **
C               **  4. RE-ENTER MONITOR AREA (SO CAN             **
C               **     COMMUNICATE WITH HOST)                    **
C               **     EXCLAMATION POINT MON K  (PAGE XXX)       **
C               ***************************************************
C
C     CORRECTIONS PROVIDED BY MARIA ZIMMER
C     WRIGHT-PATTERSON AFB, OHIO    JANUARY 1985
C
 1100 CONTINUE
CCCCC ICSTR(1:8)='!MON H K'
CCCCC NCSTR=8
      ICSTR(1:6)='!MON K'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:7)='!WOR 32'
CCCCC NCSTR=7
      ICSTR(1:9)='!WOR 32 H'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='!GRA 1,32'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:8)='!MON H K'
CCCCC NCSTR=8
      ICSTR(1:6)='!MON K'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ****************************************************************
C               **  STEP 2--
C               **  TREAT THE TEKTRONIX 4105 CASE
C               **  (A COLOR DEVICE)
C               **  1. ENABLE DIALOGUE AREA
C               **     ESCAPE KA1   (PAGE 5-14)
C               **  2. MAKE DIALOGUE AREA VISIBLE
C               **     ESCAPE LV1      (PAGE 5-39)
C               **  3. SET DIALOGUE AREA COLOR MAP--ESCAPE TF 4 INDEX HUE LIGHT
C               **     ESCAPE TF40000
C               **     ESCAPE TF410F40
C               **     ESCAPE TF42G8C2F4
C               **     ESCAPE TF43O0C2F4
C               **     ESCAPE TF440C2F4
C               **     ESCAPE TF45R<C2F4
C               **     ESCAPE TF46C<C2F4
C               **     ESCAPE TF47K4C2F4
C               **     (PAGE 5-37 AND G-1)
C               **  4. SET TEXT, TEXT CELL , AND BACKGROUND COLOR FOR DIALOGUE
C               **     ESCAPE LI100  (PAGE 5-37)
C               **   ESCAPE LZ      (PAGE 5-8)
C              1**  1. SET GRAPHICS AREA COLOR MAP
C               **     ESCAPE TG140000
C               **     ESCAPE TG1410F40
C               **     ESCAPE TG142G8C2F4
C               **     ESCAPE TG143O0C2F4
C               **     ESCAPE TG1440C2F4
C               **     ESCAPE TG145R<C2F4
C               **     ESCAPE TG146C<C2F4
C               **     ESCAPE TG147K4C2F4
C               **     (PAGE 5-37 AND G-1)
C              1**  2. SET BACKGROUND COLOR FOR GRAPHICS
C               **     ESCAPE RA101     (PAGE 5-51)
C              1**  3. SET TEXT COLOR FOR GRAPHICS
C               **     ESCAPE MT0     (PAGE 5-50)
C              1**  4. SET LINE & MARKER COLOR FOR GRAPHICS
C               **     ESCAPE ML1   (PAGE 5-45)
C              1**  5. SET LINE PATTERN (TO SOLID)
C               **     ESCAPE SINGLE (LEFT TO RIGHT) QUOTE      (PAGE 5-52)
C              1**  6. SET WINDOW TO (0,0) AND (4095,3132)
C               **     ESCAPE RW????     (PAGE 5-52 AND 98)
C               **  17. ERASE SCREEN
C               **   ESCAPE FORM-FEED
C               ****************************************************************
C
 1200 CONTINUE
CCCCC WRITE(IGUNIT,1211)IESCC
C1211 FORMAT(A1,'KA1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='KA1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1212)IESCC
C1212 FORMAT(A1,'LV1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='LV1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1221)IESCC
C1221 FORMAT(A1,'TF40000')
      ICSTR(1:1)=IESCC
      ICSTR(2:8)='TF40000'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1222)IESCC
C1222 FORMAT(A1,'TF410F40')
      ICSTR(1:1)=IESCC
      ICSTR(2:9)='TF410F40'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1223)IESCC
C1223 FORMAT(A1,'TF42G8C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TF42G8C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1224)IESCC
C1224 FORMAT(A1,'TF43O0C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TF43O0C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1225)IESCC
C1225 FORMAT(A1,'TF440C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:10)='TF440C2F4'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1226)IESCC
C1226 FORMAT(A1,'TF45R<C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TF45R<C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1227)IESCC
C1227 FORMAT(A1,'TF46C<C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TF46C<C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1228)IESCC
C1228 FORMAT(A1,'TF47K4C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TF47K4C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1231)IESCC
C1231 FORMAT(A1,'LI100')
      ICSTR(1:1)=IESCC
      ICSTR(2:6)='LI100'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1241)IESCC
C1241 FORMAT(A1,'TG140000')
      ICSTR(1:1)=IESCC
      ICSTR(2:9)='TG140000'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1242)IESCC
C1242 FORMAT(A1,'TG1410F40')
      ICSTR(1:1)=IESCC
      ICSTR(2:10)='TG1410F40'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1243)IESCC
C1243 FORMAT(A1,'TG142G8C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:12)='TG142G8C2F4'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1244)IESCC
C1244 FORMAT(A1,'TG143O0C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:12)='TG143O0C2F4'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1245)IESCC
C1245 FORMAT(A1,'TG1440C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:11)='TG1440C2F4'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1246)IESCC
C1246 FORMAT(A1,'TG145R<C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:12)='TG145R<C2F4'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1247)IESCC
C1247 FORMAT(A1,'TG146C<C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:12)='TG146C<C2F4'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1248)IESCC
C1248 FORMAT(A1,'TG147K4C2F4')
      ICSTR(1:1)=IESCC
      ICSTR(2:12)='TG147K4C2F4'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1251)IESCC
C1251 FORMAT(A1,'RA101')
      ICSTR(1:1)=IESCC
      ICSTR(2:6)='RA101'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1252)IESCC
C1252 FORMAT(A1,'MT0')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='MT0'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1253)IESCC
C1253 FORMAT(A1,'ML1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='ML1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1254)IESCC,IFFC
C1254 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IFFC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2100 CONTINUE
      CALL GROPDE
CCCCC WRITE(IGUNIT,2111)IESCC
C2111 FORMAT(1H+,A1,'.K','}')
      ICSTR(1:1)='+'
      ICSTR(2:2)=IESCC
      ICSTR(3:5)='.K}'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL GRCLDE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO INITIALIZE DEVICE--                          **
C               **  SEND    IN                                      **
C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 40, 141.                        **
C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
C               **  TAKE ON HARDWARE DEFAULT                        **
C               **  (X = 520 TO 15720 MACHINE UNITS                 **
C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
C               **  ALSO ALLOW THE PLOTTER UNITS                    **
C               **  (= PLOTTER "RESOLUTION") TO                     **
C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
C               **  3040 UNITS IN THE X DIRECTION AND               **
C               **  2000 UNITS IN THE Y DIRECTION                   **
C               ******************************************************
C
 2200 CONTINUE
CCCCC WRITE(IGUNIT,2211)
C2211 FORMAT('IN;')
C
C     THE FOLLOWING WAS COMMENTED OUT
C     ON THE SUGGESTION OF PETER VERDIER (DEC., 1984)
C
CCCCC ICSTR(1:3)='IN;'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC AUGUST 1992.  FOLLOWING LINES ADDED FOR LASER JET III
      IF(IMODE3.EQ.'LJET')THEN
        ICSTR(1:1)=IESCC
        ICSTR(2:2)='E'
        NCSTR=2
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(2:4)='%0B'
        NCSTR=4
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:3)='IN;'
        NCSTR=3
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ICSTR(1:4)='RO90'
        NCSTR=4
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
      ICSTR(1:2)='SC'
      NCSTR=2
      NCHTOT=5
      IXMIN=0
      IXMAX=IHPGX
      IYMIN=0
      IYMAX=IHPGY
      CALL GRTRIN(IXMIN,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IXMAX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IYMIN,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IYMAX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  TO INITIATE DEVICE--
C               **     STEP 1--TURN GRAPHICS DISPLAY ON
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-4, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='*dcZ'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL (LASER JET) CASE      **
C               **  LANDSCAPE ORIENTATION                               **
C               **  TO INITIATE DEVICE--                                **
C               **     ESCC E            - RESET THE PRINTER            **
C               **     ESCC &l2A         - SET LETTER SIZE PAGE         **
C               **     ESCC &l1O         - LANDSCAPE ORIENTATION        **
C               ** OR  ESCC &l0O         - PORTRAIT ORIENTATION         **
C               **     ESCC &l0L         - DISABLE SKIP PERFORATION AREA**
C               **     ESCC &l0E         - SET TOP MARGIN               **
C               **     ESCC &l51F        - 51 LINES PER PAGE            **
C               ** OR  ESCC &l66F        - 66 LINES FOR PORTRAIT        **
C               **     ESCC 9            - SET LEFT AND RIGHT MARGINS   **
C               **                       -  TO LOGICAL PAGE EDGES       **
C               **                                                      **
C               **     SET DEFAULT FONT CHARACTERISTICS (COURIER BOLD)  **
C               **                                                      **
C               **     ESCC (s0P         - FIXED SPACING                **
C               **     ESCC (s3T         - SELECT COURIER FONT          **
C               **     ESCC (s10H        - SET 10 CPI SPACING           **
C               **     ESCC (s12V        - SET 12 POINT FONT            **
C               **     ESCC (s0S         - SET UPRIGHT STYLE            **
C               **     ESCC (s0B         - SET MEDIUM STROKE WEIGHT     **
C               **     ESCC (0U          - SET ASCII SYMBOL SET         **
C               **  REFERENCE--                                         **
C               **     LASERJET SERIES II PRINTER, TECHNICAL REFERENCE  **
C               **             MANUAL, CHAPTERS 4, 5, 8                 **
C               **  NOTE THAT COMMON COMMANDS CAN BE "PACKED"           **
C               **  IF THE FIRST 2 LETTERS ARE COMMON (I.E., &l OR (s ) **
C               **  PACK BY ONLY SENDING FIRST OCCURENCE AND ONLY LAST  **
C               **  END CHARACTER AS UPPER CASE.                        **
C               **********************************************************
C
 2600 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:2)='E'
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:14)='&l2a1o0l0e51F'
      IF(IORNSW.EQ.'PORT')ICSTR(6:6)='0'
      IF(IORNSW.EQ.'PORT')ICSTR(12:13)='66'
      ICSTR(15:15)=IESCC
      ICSTR(16:31)='(s0p3t10h12v0s0B'
      ICSTR(32:32)=IESCC
      ICSTR(33:35)='(0U'
      ICSTR(36:36)=IESCC
      ICSTR(37:37)='9'
      NCSTR=37
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IPCLFC='CMED'
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('INITIALIZE DEVICE')
      ICSTR(1:17)='INITIALIZE DEVICE'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:4)='INDE'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 33--                                    **
C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
C  AUGUST 1992.  DEFINE COLOR TABLE (CURRENTLY SUPPORT 67 COLORS
C  IN CGM).
C
 3300 CONTINUE
      CALL DPCONA(39,IQUOTE)
      ICSTR(1:6)='BEGMF '
      ICSTR(7:7)=IQUOTE
      ICSTR(8:24)='DATAPLOT CGM FILE'
      ICSTR(25:25)=IQUOTE
      ICSTR(26:26)=';'
      NCSTR=26
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:18)='MFVERSION 1;'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:7)='MFDESC '
      ICSTR(8:8)=IQUOTE
      ICSTR(9:21)='AUGUST,  1992'
      ICSTR(22:22)=IQUOTE
      ICSTR(23:23)=';'
      NCSTR=23
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='MFELEMLIST '
      ICSTR(12:12)=IQUOTE
      ICSTR(13:23)='DRAWINGPLUS'
      ICSTR(24:24)=IQUOTE
      ICSTR(25:25)=';'
      NCSTR=25
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='VDCTYPE REAL;'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  AUGUST 1992.  COMMENT OUT FOLLOWING 6 LINES.  NOW ALLOW FOR
C  FULL SET OF 67 DATAPLOT COLORS.  DEFINE THE COLOR MAP.
CCCCC ICSTR(1:16)='COLRINDEXPREC 8;'
CCCCC NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:15)='MAXCOLRINDEX 8;'
CCCCC NCSTR=15
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:18)='COLRINDEXPREC 255;'
      NCSTR=18
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='MAXCOLRINDEX '
      NCSTR=13
      NCHTOT=3
      CALL GRTRIN(MAXCLR,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='COLRTABLE '
      NCHTOT=3
      DO3310I=1,MAXCLR
      NCSTR=10
      IVAL=I
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IVAL=IRED(I)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IVAL=IGREEN(I)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      IVAL=IBLUE(I)
      CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3310 CONTINUE
C  END CHANGE
      ICSTR(1:9)='FONTLIST '
      ICSTR(10:10)=IQUOTE
      ICSTR(11:24)='HARDWARE      '
      ICSTR(25:25)=IQUOTE
      ICSTR(26:26)=','
      NCSTR=26
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='         '
      ICSTR(11:24)='SIMPLEX       '
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='DUPLEX        '
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='TRIPLEX       '
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='COMPLEX       '
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='TRIPLEX ITALIC'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='SIMPLEX SCRIPT'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(11:24)='COMPLEX SCRIPT'
      ICSTR(26:26)=';'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='BEGMFDEFAULTS;'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:30)='VDCEXT 0.0, 0.0, 100.0, 100.0;'
      NCSTR=30
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='COLRMODE INDEXED;'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:21)='LINEWIDTHMODE SCALED;'
      NCSTR=21
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='ENDMFDEFAULTS;'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  USE CALCOMP LIBRARY ROUTINE                     **
C               **  ROUTINE PLOTS INITIALIZES PLOTTER               **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRINDE TO INITIALIZE DEV CALCOMP DEV.')
CCCCC ICSTR(1:51)='FIX SUBROUTINE GRINDE TO INITIALIZE DEV CALCOMP DEV.'
CCCCC NCSTR=51
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IUNIT=IGUNIT
      REWIND(IUNIT)
      IREL=53
      IDUM=0
      CALL PLOTS(IREL,IDUM,IUNIT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
C  DO NOT SWITCH TO GRAPHICS MODE UNTIL DO A SCREEN ERASE IN
C  GRERSC ROUTINE.  NORMAL ALPHANUMERIC DOES NOT WORK WELL IN
C  GRAPHICS MODE, SO LEAVE TERMINAL IN TEXT MODE AS LONG AS POSSIBLE.
C
 4600 CONTINUE
      ILAHSW='OFF'
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
C
CCCCC SPECIFY DESIRED DIMENSIONS AS MODEL (I.E., DEVICE 1 QWIN 400 300)
CQWVF IF(IMODEL.EQ.'DYNA')THEN
CQWVF   AJUNK1=-1.
CQWVF   AJUNK2=-1.
CQWVF ELSEIF(IMODEL.NE.' ' .AND. IMODE2.NE.' ')THEN
CQWVF   READ(IMODEL(1:4),'(I4.4)',ERR=4701)ITEMP1
CQWVF   READ(IMODEL(1:4),'(I4.4)',ERR=4701)ITEMP2
CQWVF   IF(ITEMP1.GE.100 .AND.ITEMP1.LE.1000)AJUNK1=REAL(ITEMP1)
CQWVF   IF(ITEMP2.GE.100 .AND.ITEMP2.LE.1000)AJUNK2=REAL(ITEMP2)
CQWVF ELSE
CQWVF   IF(QWSCRN.EQ.'VGA')THEN
CQWVF     AJUNK1=400.
CQWVF     AJUNK2=300.
CQWVF   ELSEIF(QWSCRN.EQ.'SVGA')THEN
CQWVF     AJUNK1=600.
CQWVF     AJUNK2=450.
CQWVF   ELSEIF(QWSCRN.EQ.'LARG')THEN
CQWVF     AJUNK1=700.
CQWVF     AJUNK2=550.
CQWVF   ELSEIF(QWSCRN.EQ.'JJF')THEN
CQWVF     AJUNK1=550.
CQWVF     AJUNK2=500.
CQWVF   ELSE
CQWVF     AJUNK1=600.
CQWVF     AJUNK2=450.
CQWVF   ENDIF
CQWVF ENDIF
 4701 CONTINUE
CQWVF DPSCREEN.NUMXPIXELS=-1
CQWVF DPSCREEN.NUMYPIXELS=-1
CQWVF DPSCREEN.NUMTEXTCOLS=-1
CQWVF DPSCREEN.NUMTEXTROWS=-1
CQWVF DPSCREEN.NUMCOLORS=-1
CQWVF DPSCREEN.FONTSIZE=-1
CQWVF DPSCREEN.TITLE="Dataplot Graphics"
CQWVF OPEN(UNIT=99,FILE='USER',TITLE='Dataplot Graphics',
CQWVF1IOFOCUS=.TRUE.)
C
CQWVF IF(AJUNK1.LT.0.)GOTO9000
CQWVF IRESLT=INITIALIZEFONTS()
CQWVF IRESLT=SETFONT('fh16w8b')
CQWVF MODESTATUS=GETFONTINFO(MSFONT)
CQWVF ICHRHT=MSFONT.PIXHEIGHT
CQWVF ICHRWD=MSFONT.PIXWIDTH
CQWVF IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
CQWVF IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
CQWVF MODESTATUS=SETWINDOWCONFIG(DPSCREEN)
CQWVF IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN)
CQWVF ISTATUS=DISPLAYCURSOR($GCURSORON)
CQWVF MODESTATUS=GETWINDOWCONFIG(DPSCREEN)
CQWVF IRESLT=GETWSIZEQQ(QWIN$FRAMEWINDOW,QWIN$SIZECURR,WINFO)
CQWVF AJUNK3=REAL(WINFO.W)
CQWVF AJUNK4=REAL(WINFO.H)
C
CQWVF WINFO.TYPE=QWIN$SET
CQWVF WINFO.W=50
CQWVF WINFO.H=20
CQWVF WINFO.X=10
CQWVF WINFO.Y=2
CQWVF IF(ICHRWD.GT.0)THEN
CQWVF   WINFO.W=INT(AJUNK1/REAL(ICHRWD)+0.5)
CQWVF   WINFO.X=MAX(INT((AJUNK3-AJUNK1)/REAL(ICHRWD)+0.5)-3,10)
CQWVF ENDIF
CQWVF IF(ICHRHT.GT.0)THEN
CQWVF   WINFO.H=INT(AJUNK2/REAL(ICHRHT)+0.5)
CQWVF   WINFO.Y=MAX(INT((AJUNK4-AJUNK2)/REAL(ICHRHT)+0.5)-3,2)
CQWVF ENDIF
CQWVF IRESLT=SETWSIZEQQ(99,WINFO)
CQWVF IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)
C
CQWVF NUMHPP=WINFO.W*ICHRWD
CQWVF NUMVPP=WINFO.H*ICHRHT
CQWVF ANUMHP=REAL(NUMHPP)
CQWVF ANUMVP=REAL(NUMVPP)
CQWVF IRESLT=FOCUSQQ(IPR)
CQWVF ISTATUS=DISPLAYCURSOR($GCURSORON)
CCCCC FOLLOWING CODE ADDED 7/98  (TO ALLOW USER TO SET 
CCCCC BACKGROUND AND FOREGROUND COLORS FOR TEXT WINDOW)
CCCCC MAKE DISTINCTION BETWEEN DIRECT COLOR AND VGA COLOR MODES!
      IF(IQWNCL.EQ.'VGA')THEN
        IF(IQWNBC.LT.0)IQWNBC=0
        IF(IQWNBC.GT.15)IQWNBC=15
        IF(IQWNF2.LT.0)IQWNF2=0
        IF(IQWNF2.GT.15)IQWNF2=15
        IF(IQWNBC.NE.0 .OR. IQWNF2.NE.15)THEN
CQWVF     IRESLT=SETACTIVEQQ(IPR)
CQWVF     IRESLT=SETBKCOLOR(INT2(IQWNBC))
CQWVF     IRESLT=SETTEXTCOLOR(INT2(IQWNF2))
CCCCC     CALL CLEARSCREEN($GCLEARSCREEN)
CQWVF     IRESLT=SETACTIVEQQ(99)
        ENDIF
      ELSEIF(IQWNCL.EQ.'RGB')THEN
CQWVF   IRESLT=SETACTIVEQQ(IPR)
        IF(IQWNBC.LT.0.OR.IQWNBC.GT.88)IQWNBC=0
        IF(IQWNF2.LT.0.OR.IQWNF2.GT.88)IQWNF2=1
        IF(IQWNBC.NE.0)THEN
          JTEMP=IQWNBC+1
CQWVF     JTEMP2=RGBTOINTEGER(IRED(JTEMP),IGREEN(JTEMP),IBLUE(JTEMP))
CQWVF     ISTATUS=SETBKCOLORRGB(JTEMP2)
        ENDIF
        JTEMP=IQWNF2+1
CQWVF   JTEMP2=RGBTOINTEGER(IRED(JTEMP),IGREEN(JTEMP),IBLUE(JTEMP))
CQWVF   ISTATUS=SETTEXTCOLORRGB(JTEMP2)
CQWVF   ISTATUS=SETCOLORRGB(JTEMP2)
CCCCC   CALL CLEARSCREEN($GCLEARSCREEN)
CQWVF   ISTATUS=DISPLAYCURSOR($GCURSORON)
CQWVF   IRESLT=SETACTIVEQQ(99)
      ENDIF
C
CCCCC NOVEMBER 2002.  SUPPORT FOR "-TILE" OPTION.
C
CQWVF IF(IQWNTL.EQ.'ON')THEN
CQWVF   IRESLT=CLICKMENUQQ(QWIN$TILE)
CQWVF ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IORNSW.EQ.'LAND')THEN
        IORIEN=0
      ELSE IF(IORNSW.EQ.'PORT')THEN
        IORIEN=1
      ELSE IF(IORNSW.EQ.'SQUA')THEN
        IORIEN=3
      ELSE
        IORIEN=2
      END IF
C
      DO4810I=20,1,-1
        ILAST=I
        IF(IX11DN(I:I).NE.' ')GOTO4819
 4810 CONTINUE
 4819 CONTINUE
      DO4820I=1,ILAST
        CALL DPCOAN(IX11DN(I:I),IJUNK)
        IADE(I)=IJUNK
 4820 CONTINUE
      IADE(ILAST+1)=0
C
      DO4829I=1,8
      IWIND(I)=-1
 4829 CONTINUE
      ICOUNT=0
      IF(IMODEL.EQ.'    '.AND.IMODE2.EQ.'    ')GOTO4839
      CTEMP(1:4)=IMODEL(1:4)
      CTEMP(5:8)=IMODE2(1:4)
      ICOUNT=0
      DO4830I=8,1,-1
        IA=CTEMP(I:I)
        IF(IA.EQ.' ')GOTO4830
        ICOUNT=ICOUNT+1
        CALL DPCOAN(IA,IVALUE)
        IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
          IWIND(ICOUNT)=IVALUE-48
        ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
          IWIND(ICOUNT)=IVALUE-55
        ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
          IWIND(ICOUNT)=IVALUE-87
        ELSE
          ICOUNT=1
          WRITE(ICOUT,4833)
          GOTO4839
        ENDIF
 4830 CONTINUE
 4833 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
 4839 CONTINUE
      CALL GLINIT(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,IADE,IWIND,ICOUNT,
     1IERRNO)
      IF(IERRNO.EQ.1) THEN
         WRITE(ICOUT,4851)
 4851    FORMAT('CANNOT OPEN X11 WINDOW.')
         CALL DPWRST('XXX','BUG ')
         IX11OF='OFF'
      ELSE
         IX11OF='ON'
         ANUMHP=REAL(IXPIX)
         ANUMVP=REAL(IYPIX)
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
CINTE CALL IScreenOpen(' ','GW',800,600,16)
CINTE CALL IScreenTitle('G','Dataplot')
CINTE CALL IScreenInit(' ')
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IHAND1=0
      IHAND2=1
CWINT CALL WInitialise(' ')
CWINT ISCRWID=WInfoScreen(1)
CWINT ISCRHGT=WInfoScreen(2)
CWINT ISCCOL=WInfoScreen(3)
CWINT WINDOW%FLAGS=SysMenuOn + MinButton + MaxButton
CWINT WINDOW%X=ISCRWID - (IWINHP + 10)
CWINT WINDOW%Y=(ISCRHGT - IWINVP) - 50
CWINT WINDOW%WIDTH=IWINHP
CWINT WINDOW%HEIGHT=IWINVP
CWINT IDR_MENU1=30001
CWINT WINDOW%MENUID=IDR_MENU1
CWINT WINDOW%TITLE='Dataplot Graphics'
CCCCC CALL WindowOpenChild(WINDOW,IHAND2)
CWINT CALL WindowOpen(WINDOW)
CWINT CALL WindowSelect(IHAND1)
C
CWINT IXPIX=WInfoWindow(1)
CWINT IYPIX=WInfoWindow(2)
CCCCC ANUMHP=REAL(IXPIX)
CCCCC ANUMVP=REAL(IYPIX)
      IF(IWINCL.EQ.'RGB')THEN
CWINT   CALL IGrPaletteInit()
        JCOL=1
CWINT   CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
CWINT   IERRO2=InfoError(1)
CWINT   ISTAT2=InfoError(2)
        DO4960I=1,MAXCLR
          IINDEX=I
CWINT     CALL IGrPaletteRGB(IINDEX,IRED(IINDEX),IGREEN(IINDEX),
CWINT1                       IBLUE(IINDEX))
CWINT     IERRO2=InfoError(1)
CWINT     ISTAT2=InfoError(2)
          IF(IERRO2.EQ.1 .OR. IERRO2.EQ.2)THEN
            WRITE(ICOUT,4969) IINDEX
 4969       FORMAT('*****LAHEY: ERROR LOADING COLOR INDEX ',I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 4960   CONTINUE
CWINT   CALL IgrColourN(2)
      ELSE
CWINT   CALL IGrPaletteInit()
CWINT   CALL IgrColourN(223)
      ENDIF
CWINT CALL IGrArea(0.,0.,1.,1.)
CWINT CALL IGrAreaClear()
CWINT CALL IGrUnits(0.,0.,100.,100.)
      ISTEMP=' '
      ISTEMP(1:NCPATH)=PATH(1:NCPATH)
      NC1=NCPATH+1
      NC2=NCPATH+9
      ISTEMP(NC1:NC2)='fixed.chr'
      IERRO2=0
CWINT CALL IGrCharSet(ISTEMP)
CCCCC CALL IGrCharSet('H')
CWINT   IERRO2=InfoError(1)
CWINT   ISTAT2=InfoError(2)
        IF(IERRO2.EQ.1 .OR. IERRO2.EQ.2)THEN
          WRITE(ICOUT,4979)
 4979     FORMAT('*****LAHEY: ERROR LOADING FONT FILE')
          CALL DPWRST('XXX','BUG ')
        ENDIF
CWINT CALL IGrCharSpacing('F')
CCCCC CALL WindowSelect(IHAND1)
CWINT CALL IGrLineType(0)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO INITIALIZE DEVICE--                          **
C               **  USE THE 70 OP CODE (= RESET)                    **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 , B-1, AND E-1             **
C               **  MARCH, 1988 - USE ZETA EXTENDED CALCOMP LIBRARY **
C               **  PLOTS - INITIALIZES DEVICE                      **
C               **  DASHDF - DEFINE DEFAULT DASHED LINE PATTERNS    **
C               ******************************************************
C
 5100 CONTINUE
CCCCC WRITE(IGUNIT,5111)
C5111 FORMAT('70')
CCCCC ICSTR(1:2)='70'
CCCCC NCSTR=2
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C     USE THE CALCOMP LIBRARY ROUTINES
C
      IUNIT=IGUNIT
      REWIND(IUNIT)
      IREL=53
      IDUM=0
      CALL PLOTS(IREL,IDUM,IUNIT)
      CALL DASHDF(0,0,0,0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO INITIALIZE DEVICE--                          **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRINDE TO INITIALIZE DEV RAMTEK DEV.')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   MAY 1991  (ALAN)
CCCCC ICSTR(1:50)='FIX SUBROUTINE GRINDE TO INITIALIZE DEV RAMTEK DEV.'
CCCCC NCSTR=50
      ICSTR(1:51)='FIX SUBROUTINE GRINDE TO INITIALIZE DEV RAMTEK DEV.'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               **  WRITTEN BY BILL ANDERSON                        **
C               ******************************************************
C
 6600 CONTINUE
      IDUMMY=0
CSUN  CALL isitcolor(IDUMMY)
      ISUNCL=IDUMMY
      IF (ISUNCL.LT.0) THEN
         WRITE(ICOUT,6601) 
 6601    FORMAT('Trouble opening SUN graphics window')
         CALL DPWRST('XXX','BUG ')
         GOTO 6620
      ENDIF
      IF(ISUNCL.EQ.1)THEN
         DD = 5
         CMAPSZ = 8
         CMAPNM = 'DATAPLOT'
      ELSE
         DD = 4
      ENDIF
CSUN  CALL cfopencgi()
      RETNED = 1
CSUN  CALL cfopenvws(IVSNAM,SCNNAM,WINNAM,WINDFD,
CSUN 1  RETNED,DD,CMAPSZ,CMAPNM,FLAGS,PTR,NOARGS,
CSUN 2  200,200,200,200)
      IF(ISUNCL.EQ.1) THEN
C    BLACK(I.E. 'DARK')
C  APRIL 1990: FOLLOWING 3 LINES MODIFIED AT SUGGESTION OF BILL ANDERSON.
C  SEEMS THAT ON 3/80 SUN'S, SETTING TO 0 GIVES WHITE, NOT BLACK.
CCCCC    RD(1) = 0
CCCCC    GN(1) = 0
CCCCC    BE(1) = 0
         RD(1) = 1
         GN(1) = 1
         BE(1) = 1
C    RED
         RD(2) = 244
         GN(2) = 9
         BE(2) = 6
C    GREEN
         RD(3) = 50
         GN(3) = 198
         BE(3) = 12
C    BLUE
         RD(4) = 120
         GN(4) = 215
         BE(4) = 247
C    YELLOW
         RD(5) = 254
         GN(5) = 241
         BE(5) = 108
C    ORANGE
C        RD(6) = 245
C        GN(6) = 176
C        BE(6) = 33
C    BLACK
C    APRIL 1990, SAME PATCH AS ABOVE
CCCCC    RD(6) = 0
CCCCC    GN(6) = 0
CCCCC    BE(6) = 0
         RD(1) = 1
         GN(1) = 1
         BE(1) = 1
C    PURPLE
         RD(7) = 189
         GN(7) = 102
         BE(7) = 249
C    WHITE
         RD(8) = 255
         GN(8) = 255
         BE(8) = 255
CSUN     CALL cfcotable(0,RD,GN,BE,8)
      ENDIF
CSUN  CALL cfvdcext(1,1,10000,10000)
CSUN  CALL cftextprec(1)
CSUN  CALL cffixedfont(1)
CSUN  CALL cfcharexpfac(.5)
CSUN  CALL cfcharspacing(0.)
CSUN  CALL cfintstyle(1,1)
 6620 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO INITIALIZE DEVICE--                          **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRINDE TO INITIALIZE DEV XXXXXX DEV.')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   MAY 1991  (ALAN)
CCCCC ICSTR(1:50)='FIX SUBROUTINE GRINDE TO INITIALIZE DEV XXXXXX DEV.'
CCCCC NCSTR=50
      ICSTR(1:51)='FIX SUBROUTINE GRINDE TO INITIALIZE DEV XXXXXX DEV.'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO INITIALIZE DEVICE---                         **
C               **  WRITE OUT AN   XX                               **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 8100 CONTINUE
      IREGMC=3
      IF(IMODEL.EQ.'340'.OR.IMODEL.EQ.'VT-3')IREGMC=15
      GOTO9000
C
C               ******************************************************
C               **  STEP 86                                         **
C               **  TREAT THE POSTSCRIPT  CASE                      **
C               **  1) DEFINE 8 PROCEDURES:                         **
C               **     RIGHTSHOW -  PRINT A RIGHT JUSTIFIED STRING  **
C               **     CENTSHOW  -  PRINT A CENTER JUSTIFIED STRING **
C               **     LEFTSHOW  -  PRINT A LEFT JUSTIFIED STRING   **
C               **     VRIGHTSHOW - PRINT A VERTICAL RIGHT (I.E.,   **
C               **                  TOP) JUSTIFIED STRING           **
C               **     VCENTSHOW  - PRINT A VERTICAL CENTER         **
C               **                  JUSTIFIED STRING                **
C               **     VLEFTSHOW  - PRINT A VERTICAL LEFT (I.E.,    **
C               **                  BOTTOM) JUSTIFIED STRING        **
C               **     L          - ABBREVIATION FOR LINETO         **
C               **     M          - ABBREVIATION FOR MOVETO         **
C               **  2) SET INITIAL HARDWARE FONT (DEF = TIMES-ROMAN)**
C               **     FOR DATAPLOT DEFAULT SIZE (HEIGHT = 2.0,     **
C               **     USE 12 POINT FONT                            **
C               **     THE VERTICAL GAP IS NOT PART OF THE HEIGHT   **
C               **     THE CURRENT FONT AND POINT SIZE ARE STORED IN**
C               **     THE DEVICE COMMON BLOCKS AND MAY BE CHANGED  **
C               **     VIA "SET" COMMANDS.                          **
C               **  3) SCALE PLOT TO DESIRED POINTS PER INCH        **
C               **     (POSTSCRIPT DEFAULT IS 72, MOST DEVICES 300) **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **             COOKBOOK, ADOBE SYSTEMS              **
C               **             POSTSCRIPT LANGUAGE REFERENCE        **
C               **             MANUAL, ADOBE SYSTEMS                **
C               **  NOTE: POSTSCRIPT IS CASE SENSITIVE!!!           **
C               **  MODIFIED JANUARY 1990.                          **
C               **  A) SUPPORT ENCAPSULATED POSTSCRIPT              **
C               **     NOTE THAT ENCAPSULATED POSTSRIPT MEANS EACH **
C               **     PAGE MUST BE SELF-CONTAINED, SO STUFF NORMALLY*
C               **     DONE HERE WILL BE DONE IN GRERSC INSTEAD.    **
C               **     IF MORE THAN ONE PAGE GENERATED, THE USER    **
C               **     WILL NEED TO SPLIT THE FILE UP VIA AN EDITOR **
C               **     TO PUT EACH PAGE INTO A SEPARATE FILE.       **
C               **  B) ENCAPSULATED POSTSCRIPT MUST BE IN           **
C               **     "CONFORMING" STYLE (SEE APPENDIX C OF        **
C               **     POSTSCRIPT LANGUAGE REFERENCE MANUAL BOOK    **
C               **     (THE RED ONE) FOR DETAILS.  FOR CONSISTENCY, **
C               **     USE CONFORMING STYLE EVEN IF DO NOT USE      **
C               **     ENCAPSULATED POSTSCRIPT.                     **
C               **  NOTE THAT ENCAPSULATED POSTSCRIPT SHOULD ONLY   **
C               **  BE USED IF NEEDED TO INTEGRATE INTO ANOTHER     **
C               **  PROGRAM (E.G., WORDPERFECT OR PAGE MAKER).      **
C               ******************************************************
C
C  NOVEMBER, 1990 BUG FIX.  MODIFIED HOW MARGINS ARE HANDLED.
C  OCTOBER, 1991.  ADDITIONAL FONTS, ALSO "%!" IN COL. 1 OR COL. 2
C  DECEMBER 1991.  BUG FIX IN BOUNDING BOX (SHOULD BE BASED ON DEFAULT
C  POSTSCRIPT UNITS, NOT IN DATAPLOT POSTSCRIPT UNITS).
C  JANUARY 1993.  NO LEADING SPACE BEFORE "%%" CAUSED PROBLEM WITH
C  FRAMEMAKER.
C  JANUARY 2003: DATAPLOT SETS BOUNDING BOX TO 11INx11IN BY DEFAULT
C                SINCE IT CAN SWITCH BETWEEN LANDSCAPE/PORTRAIT
C                MODES.  HOWEVER, SOMETIMES FOR IMPORTING INTO OTHER
C                PROGRAMS, IT IS PREFFERABLE TO SET THE BOUNDING BOX
C                MORE EXPLICITLY (I.E., LANDSCAPE OR PORTRAIT).  THE
C                SET POSTSCRIPT BOUNDING BOX FIXED COMMAND WILL SET
C                THIS EXPLICIT BOUNDING BOX.
C  JANUARY 2003: DATAPLOT DOES AN INITIAL PAGE ERASE IN CASE
C                DIAGRAMMATIC GRAPHICS BEING GENERATED.  SET AN INTERNAL
C                VARIABLE (IPSTNW) TO INDICATE PAGE ERASE HAS BEEN
C                PERFORMED.
C
 8600 CONTINUE
C  FOLLOWING SECTION MODIFIED JANUARY, 1990 TO BE "CONFORMING" POSTSCRIPT
c  JANUARY 1993.  ONLY SET PAGE NUMBER FOR DEVICE 2
      IF(IMODE3.NE.'DEV3')THEN
        IPSTPN=0
      ENDIF
      IF(IMODEL.EQ.'ENCA')GOTO9000
CCCCC ICSTR(1:40)='%! - THIS LINE REQUIRED FOR UNIX SYSTEMS'
CCCCC FOLLOWING LINES MODIFIED.  SOME SYSTEMS WANT COLUMN 1, OTHERS COLUMN 2
      ICSTR(1:14)='%!PS-Adobe-2.0'
      NCSTR=14
      IF(IPSTSP.EQ.'OFF'.OR.IPSTSP.EQ.'NO'.OR.IPSTSP.EQ.'FALS')THEN
        IPSTSP='OFF'
        NCSTR=-14
      END IF
C  END CHANGE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  FOLLOWING LINES ADDED JANUARY, 1990.
C
C  JANUARY 1993.  NO LEADING SPACE BEFORE "%%"
C
      ICSTR(1:19)='%%Creator: Dataplot'
      NCSTR=19
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:33)='%%Title: Dataplot Postscript File'
      NCSTR=33
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:20)='%%CreationDate: NULL'
      NCSTR=20
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:16)='%%Pages: (atend)'
      NCSTR=16
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:40)='%%DocumentFonts: Times-Roman Times-Bold '
      ICSTR(41:69)='Times-Italic Times-BoldItalic'
      NCSTR=69
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:46)='%%+ Helvetica Helvetica-Bold Helvetica-Oblique'
      ICSTR(47:76)=' Helvetica-BoldOblique Courier'
      NCSTR=76
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:33)='%%+ Courier-Bold Courier-Oblique '
      ICSTR(34:53)=' Courier-BoldOblique'
      NCSTR=53
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  OCTOBER 1991.  ADDITIONAL FONTS ADDED
      ICSTR(1:42)='%%+ AvantGarde-Book AvantGarde-BookOblique'
      ICSTR(43:81)=' AvantGarde-Demi AvantGarde-DemiOblique'
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Bookman-Demi Bookman-DemiItalic       '
      ICSTR(43:81)='Bookman-Light Bookman-LightItalic      '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Helvetica-Narrow Helvetica-Narrow-Bold'
      ICSTR(43:81)=' Helvetica-Narrow-BoldOblique          '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Helvetica-Narrow-Oblique              '
      ICSTR(43:81)='NewCentury-Schlbk-Bold                 '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ NewCentury-Schlbk-Italic              '
      ICSTR(43:81)='NewCenturySchlbk-BoldItalic            '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ Palatino-Roman Palatino-Bold          '
      ICSTR(43:81)='Palatino-Italic Palatino-BoldItalic    '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:42)='%%+ ZapfChancery-MediumItalic  Symbol     '
      ICSTR(43:81)='                                       '
      NCSTR=81
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  END CHANGE
      ICSTR(1:19)='%%BoundingBox: 0 0 '
      NCSTR=19
      NCHTOT=5
C  DECEMBER 1991.  FOLLOWING LINE CHANGED.  BASE ON DEFAULT POSTSCRIPT
C  UNITS (72 PPI) RATHER THAN DATAPLOT UNITS.
C  JANUARY 2003.  BOUNDING BOX CAN BE EITHER FIXED (LANDSCAPE OR
C  PORTRAIT) OR FLOATING (CAN SWITCH BETWEEN LANDSCAPE OR PORTRAIT).
CCCCC IJUNK=INT(PSTPPI*11.+0.5)
CCCCC IJUNK=INT(72.*11.+0.5)
CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=' '
CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:13)='%%EndComments'
CCCCC NCSTR=13
      IF(IPSTBB.EQ.'FIXE')THEN
        IF(IORNSW.EQ.'PORT')THEN
          ICSTR(1:26)='%%BoundingBox: 0 0 612 792'
          NCSTR=26
        ELSEIF(IORNSW.EQ.'LAND')THEN
          ICSTR(1:26)='%%BoundingBox: 0 0 792 612'
          NCSTR=26
        ELSEIF(IORNSW.EQ.'LAN2')THEN
          ICSTR(1:26)='%%BoundingBox: 0 0 612 468'
          NCSTR=26
        ELSEIF(IORNSW.EQ.'SQUA')THEN
          ICSTR(1:26)='%%BoundingBox: 0 0 612 612'
          NCSTR=26
        ELSE
          ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
          NCSTR=26
        ENDIF
      ELSE
        ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
        NCSTR=26
      ENDIF
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  END JANUARY 1993 CHANGES
C
      ICSTR(1:43)='% DATAPLOT POSTSCRIPT DRIVER, JANUARY, 1990'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:43)='% PROLOG SECTION: DATAPLOT DEFINITIONS     '
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "rightshow" TO PRINT RIGHT'
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:20)='% (STRING) rightshow'
      NCSTR=20
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/rightshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IX exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   IY moveto'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "centshow" TO PRINT CENTER'
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='% (STRING) centshow'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='/centshow'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:8)='   2 div'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IX exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   IY moveto'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:44)='%DEFINE PROCEDURE "leftshow" TO PRINT LEFT  '
      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
      NCSTR=72
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='% (STRING) leftshow'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:9)='/leftshow'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:25)='  {IX IY moveto show} def'
      NCSTR=25
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vrightshow" TO PRINT RIGHT'
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:30)='% (STRING) vrightshow grestore'
      NCSTR=30
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='/vrightshow'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IY exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='   IX exch moveto'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='    90 rotate'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vcentshow" TO PRINT CENTER'
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:29)='% (STRING) vcentshow grestore'
      NCSTR=29
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/vcentshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:22)='  {dup stringwidth pop'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:8)='   2 div'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='   IY exch sub'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:17)='   IX exch moveto'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:14)='     90 rotate'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:12)='   show} def'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:45)='%DEFINE PROCEDURE "vleftshow" TO PRINT LEFT  '
      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
      NCSTR=82
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
      NCSTR=35
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:28)='% newpath IX IY moveto gsave'
      NCSTR=28
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:29)='% (STRING) vleftshow grestore'
      NCSTR=29
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='/vleftshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:36)='  {IX IY moveto 90 rotate show} def'
      NCSTR=36
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:52)='% DEFINE PROCEDURE "l" AS ABBREVIATION OF lineto'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:15)='/l {lineto} def'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:52)='% DEFINE PROCEDURE "m" AS ABBREVIATION OF moveto'
      NCSTR=52
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:15)='/m {moveto} def'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  ***************************************************************
C  **  SET DEFAULT POSTSCRIPT FONT TO BE TIMES-ROMAN.  NOTE     **
C  **  THAT THE DEFAULT DATAPLOT SIZE IS 2.0 FOR THE CHARACTER  **
C  **  AND 0.75 FOR THE VERTICAL GAP.  POSTSCRIPT WORKS IN      **
C  **  "POINTS" WHICH ARE 1/72 AN INCH.  HOWEVER, DATAPLOT      **
C  **  POSTSCRIPT UNITS (72 DOTS PER INCH) TO THE ACTUAL DOTS   **
C  **  PER INCH (TYPICALLY 300).  THIS MEANS 1 UNIT CORRESPONDS **
C  **  TO ONE PIXEL OR DOT.  THE DEFAULT FONT WILL BE RESET     **
C  **  EVERY TIME AN ERASE PAGE IS DONE (SINCE GRERSC DOES A    **
C  **  "GRESTORE" COMMAND.  THE USER CAN DETERMINE THE DEFAULT  **
C  **  STYLE VIA A "SET POSCRIPT FONT <...> COMMAND.            **
C  ***************************************************************
C
C  MAY,1989, ALAN HECKERT.  BE SURE TO DEFINE THE DEFAULT PAGE SCALING,
C  TRANSLATION AND ORIENTATION (WAS A BUG WITH DIAGRAMMATIC GRAPHICS
C  IF AN ERASE WAS NOT DONE FIRST).
C  FOLLOWING CODE MODIFIED OCTOBER 1991.  MAKE FONT TABLE DRIVEN
      APOINT=ANUMVP*2.0/100.
      IPOINT=INT(APOINT)
C
      IJUNK=7
      DO8695I=1,IPSTMF
      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
      IJUNK=I
      GOTO8697
 8695 CONTINUE
 8697 CONTINUE
      ICSTR(1:1)='/'
      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
      ICSTR(42:51)=' findfont '
      NCHTOT=3
      NCSTR=51
      CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+17
      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:33)='/Times-Roman            findfont '
CCCCC IF(IPSTFN.EQ.'TBOL')
CCCCC1ICSTR(1:23)='/Times-Bold            '
CCCCC IF(IPSTFN.EQ.'TITA')
CCCCC1ICSTR(1:23)='/Times-Italic          '
CCCCC IF(IPSTFN.EQ.'TBIT')
CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
CCCCC IF(IPSTFN.EQ.'HELV')
CCCCC1ICSTR(1:23)='/Helvetica             '
CCCCC IF(IPSTFN.EQ.'HELB')
CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
CCCCC IF(IPSTFN.EQ.'HELO')
CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
CCCCC IF(IPSTFN.EQ.'HEBO')
CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
CCCCC IF(IPSTFN.EQ.'COUR')
CCCCC1ICSTR(1:23)='/Courier               '
CCCCC IF(IPSTFN.EQ.'CBOL')
CCCCC1ICSTR(1:23)='/Courier-Bold          '
CCCCC IF(IPSTFN.EQ.'COBL')
CCCCC1ICSTR(1:23)='/Courier-Oblique       '
CCCCC IF(IPSTFN.EQ.'CBOB')
CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
CCCCC NCSTR=33
CCCCC NCSTR=33
CCCCC NCHTOT=3
CCCCC CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(37:54)=' scalefont setfont'
CCCCC NCSTR=54
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  END CHANGE
      IPSTFC=IPSTFN
      IPSTPS=IPOINT
      IPSTPC=IPOINT
      IPSTPO=IPOINT
C  JUNE, 1989.  A NEW PAGE RESETS THE FONT TO WHAT IS SET IN GRINDE.
C  ADDED IPSTFO TO DPCODV AND MODIFIED GRERSC.
      IPSTFO=IPSTFN
C
      ICSTR(1:41)='gsave    % SAVE INITIAL GRAPHICS STATE'
      NCSTR=41
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C  ADD FOLLOWING LINES JANUARY, 1990.
C  JANUARY 1993.  LEADING SPACE FOR "%%" LINES
      ICSTR(1:11)='%%EndProlog'
      NCSTR=11
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC JANUARY 1993.  ONLY INCREMENT FOR DEVICE 2!
      IF(IMODE3.NE.'DEV3')THEN
        IPSTPN=1
      ENDIF
      ICSTR(1:11)='%%Page: 1 1'
      NCSTR=11
      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C END ADDITIONS
      ICSTR(1:11)='0 0 moveto '
      NCSTR=11
      XPPI=PSTPPI
      YPPI=PSTPPI
      XSCALE=72./XPPI
      YSCALE=72./YPPI
      NCSTR=11
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(22:22)=' '
      NCSTR=22
      CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(33:39)=' scale '
      NCSTR=39
C
      IF(IORNSW.EQ.'LAND')THEN
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'PORT')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IVTEMP=IPS2BM
        IHTEMP=IPS2LM
      ELSE
        IVTEMP=IPSTBM
        IHTEMP=IPSTLM
      END IF
      IXTR=IHTEMP
      IYTR=IVTEMP
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1IXTR=IHTEMP+ANUMVP+0.5
      NCHTOT=5
      CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(45:45)=' '
      NCSTR=45
      CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
      ICSTR(51:61)=' translate '
C
      ICSTR(62:63)=' 0'
      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
     1ICSTR(62:63)='90'
      ICSTR(64:71)=' rotate '
      NCSTR=71
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(IMODE3.NE.'DEV3')IPSTNW='ON'
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 90--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  1) TURN QUIC ON - "^PY^-" ON LINE BY ITSELF     **
C               **  2) SET DEFAULT COMMAND SYNTAX - "^ISYNTAX00000" **
C               **  3) SET DEFAULT FONT           - "^ISxxxxx       **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='PY'
      ICSTR(4:4)=ICARAT
      ICSTR(5:5)='-'
      NCSTR=-5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:13)='ISYNTAX00000'
      NCSTR=13
      KFONT=IQUIFN
      ICSTR(14:14)=ICARAT
      ICSTR(15:16)='IS'
      NCHTOT=-5
      NCSTR=16
      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IQUIFC=IQUIFN
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  USE A C LIBRARY WRITTEN BY ALAN HECKERT         **
C               ******************************************************
C
 9600 CONTINUE
      IF(IORNSW.EQ.'LAND')THEN
        IORIEN=0
      ELSE IF(IORNSW.EQ.'PORT')THEN
        IORIEN=1
      ELSE IF(IORNSW.EQ.'SQUA')THEN
        IORIEN=3
      ELSE
        IORIEN=2
      END IF
C
      DO9610I=20,1,-1
        ILAST=I
        IF(IX11DN(I:I).NE.' ')GOTO9619
 9610 CONTINUE
 9619 CONTINUE
      DO9620I=1,ILAST
        CALL DPCOAN(IX11DN(I:I),IJUNK)
        IADE(I)=IJUNK
 9620 CONTINUE
      IADE(ILAST+1)=0
C
      DO9629I=1,8
      IWIND(I)=-1
 9629 CONTINUE
      ICOUNT=0
      IF(IMODEL.EQ.'    '.AND.IMODE2.EQ.'    ')GOTO9639
      CTEMP(1:4)=IMODEL(1:4)
      CTEMP(5:8)=IMODE2(1:4)
      ICOUNT=0
      DO9630I=8,1,-1
        IA=CTEMP(I:I)
        IF(IA.EQ.' ')GOTO9630
        ICOUNT=ICOUNT+1
        CALL DPCOAN(IA,IVALUE)
        IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
          IWIND(ICOUNT)=IVALUE-48
        ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
          IWIND(ICOUNT)=IVALUE-55
        ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
          IWIND(ICOUNT)=IVALUE-87
        ELSE
          ICOUNT=1
          WRITE(ICOUT,9633)
          GOTO9639
        ENDIF
 9630 CONTINUE
 9633 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
 9639 CONTINUE
      CALL XINIT(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,IADE,IWIND,ICOUNT,
     1IERRNO)
      IF(IERRNO.EQ.1) THEN
         WRITE(ICOUT,9651)
 9651    FORMAT('CANNOT OPEN X11 WINDOW.')
         CALL DPWRST('XXX','BUG ')
         IX11OF='OFF'
      ELSE
         IX11OF='ON'
         ANUMHP=REAL(IXPIX)
         ANUMVP=REAL(IYPIX)
      ENDIF
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  USE A C DRIVER WRITTEN BY JJF              **
C               *************************************************
C
10000 CONTINUE
      CALL TCINDE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CGKS  CALL GOPKS(IGKSNU, IWRKSP)
CCKS  CALL GOPWK(IGKSID, IGKSCN, IGKSWK)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  TREAT THE PBM (PORTABLE BIT MAP) DRIVER         **
C               ******************************************************
C
12000 CONTINUE
C
12010 CONTINUE
      ITYPE=1
      GOTO12090
C
12020 CONTINUE
      ITYPE=2
      GOTO12090
C
12030 CONTINUE
      ITYPE=3
      GOTO12090
C
12040 CONTINUE
      ITYPE=4
      GOTO12090
C
12090 CONTINUE
C
      CALL GDINIT(ITYPE)
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      XPIXMN=100.0
      XPIXMX=700.0
      YPIXMN=100.0
      YPIXMX=550.0
CMACI CALL MIGSetup(XPIXMN,XPIXMX,YPIXMN,YPIXMX,ACOORD)
      AXMN=0.0
      AXMX=100.0
      AYMN=0.0
      AYMX=100.0
      IDISP=0
CMACI CALL DefineCoord(AXMN,AYMN,AXMX,AYMX,IDISP,BCOORD)
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
C  STEP 1: INITIALIZE DEVICE
C  STEP 2: DEFINE COLOR MAP
C
13500 CONTINUE
CAQUA CALL aqtInit()
C
      DO13510I=1,MAXCLR
        IVAL1=IRED(I)
        VAL1=REAL(IVAL1)/255.0
        IVAL2=IGREEN(I)
        VAL2=REAL(IVAL2)/255.0
        IVAL3=IBLUE(I)
        VAL3=REAL(IVAL3)/255.0
        IENTRY=I-1
CAQUA   CALL aqtSetColormapEntry(IENTRY,VAL1,VAL2,VAL3)
13510 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               **  TWO CASES:                                      **
C               **  1) DEVICE xxx LATEX INDEPENDENT                 **
C               **     TREAT THE LATEX GRAPH AS AN INDEPENDENT.     **
C               **     PREAMBLE.                                    **
C               **  2) DEVICE xxx LATEX                             **
C               **     TREAT THE LATEX GRAPH AS SOMETHING TO BE     **
C               **     INCORPORATED INTO LARGER LATEX DOCUMENT.     **
C               **     IN THIS CASE, DO NOTHING.                    **
C               ******************************************************
C
15000 CONTINUE
C
      IF(IMODEL.EQ.'STAN')THEN
C
        ICSTR=' '
        IF(ILATHE.EQ.'NULL')THEN
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:29)='documentclass[12pt]{article}'
          NCSTR=29
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=' '
          NCSTR=1
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:99)='usepackage{epsfig}'
          NCSTR=19
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:23)='usepackage{epic,eepic}'
          NCSTR=23
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:27)='usepackage{graphics,color}'
          NCSTR=27
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=' '
          NCSTR=1
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:30)='setlength{ textwidth}{6.25in}'
          ICSTR(12:12)=IBASLC
          NCSTR=30
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:28)='setlength{ textheight}{9in}'
          ICSTR(12:12)=IBASLC
          NCSTR=28
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:34)='setlength{ oddsidemargin}{0.25in}'
          ICSTR(12:12)=IBASLC
          NCSTR=34
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:32)='setlength{ evensidemargin}{0in}'
          ICSTR(12:12)=IBASLC
          NCSTR=32
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:30)='setlength{ headheight}{0.5in}'
          ICSTR(12:12)=IBASLC
          NCSTR=30
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:28)='setlength{ headsep}{0.5in}'
          ICSTR(12:12)=IBASLC
          NCSTR=28
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:28)='setlength{ topmargin}{-1in}'
          ICSTR(12:12)=IBASLC
          NCSTR=28
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:27)='setlength{ parindent}{0in}'
          ICSTR(12:12)=IBASLC
          NCSTR=27
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:26)='setlength{ parskip}{10pt}'
          ICSTR(12:12)=IBASLC
          NCSTR=26
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:30)='setlength{ textfloatsep}{4ex}'
          ICSTR(12:12)=IBASLC
          NCSTR=30
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:31)='addtolength{ footskip}{0.25in}'
          ICSTR(14:14)=IBASLC
          NCSTR=31
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:17)='overfullrule=0pt'
          NCSTR=17
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=IBASLC
          ICSTR(2:18)='baselineskip=12pt'
          NCSTR=18
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
          ICSTR(1:1)=' '
          NCSTR=1
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     PGRAPHIC AND LGRAPHIC FOR IMPORTING EXTERNAL
CCCCC     POSTSCRIPT FILES.  NOT RELEVANT IN THIS CONTEXT,
CCCCC     SO COMMENT OUT FOR NOW.
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:12)='newcommand{'
CCCCC     ICSTR(13:13)=IBASLC
CCCCC     ICSTR(14:26)='PGRAPHIC}[1]{'
CCCCC     ICSTR(27:27)=IBASLC
CCCCC     ICSTR(28:43)='begin{figure}[h]'
CCCCC     NCSTR=43
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:28)='epsfig{file=#1,width=6.0in}'
CCCCC     NCSTR=28
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:13)='end{figure}}'
CCCCC     NCSTR=13
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:12)='newcommand{'
CCCCC     ICSTR(13:13)=IBASLC
CCCCC     ICSTR(14:26)='LGRAPHIC}[1]{'
CCCCC     ICSTR(27:27)=IBASLC
CCCCC     ICSTR(28:43)='begin{figure}[h]'
CCCCC     NCSTR=43
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:38)='epsfig{file=#1,angle=-90,width=6.0in}'
CCCCC     NCSTR=38
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:13)='end{figure}}'
CCCCC     NCSTR=13
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=' '
CCCCC     NCSTR=1
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=IBASLC
CCCCC     ICSTR(2:16)='begin{verbatim}'
CCCCC     NCSTR=16
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC     ICSTR(1:1)=' '
CCCCC     NCSTR=1
CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ELSE
          IOUNI1=IST1NU
          IFILE1=ILATHE
          ISTAT1='OLD'
          IFORM1='FORMATTED'
          IACCE1='SEQUENTIAL'
          IPROT1='READONLY'
          ICURS1='CLOSED'
          ISUBN0='CAPT'
          IERRF1='NO'
C
          IREWI1='ON'
          CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,
     1                IPROT1,ICURS1,
     1                IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
          IF(IERRF1.EQ.'YES')GOTO9000
C
C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
C
          DO15301I=1,1000
            IATEMP=' '
            READ(IOUNI2,15392,END=15399,ERR=15399)IATEMP
15392       FORMAT(A240)
            ILAST=1
            DO15410J=240,1,-1
              IF(IATEMP(J:J).NE.' ')THEN
                ILAST=J
                GOTO15419
              ENDIF
15410       CONTINUE
15419       CONTINUE
            ICSTR(1:ILAST)=IATEMP(1:ILAST)
            NCSTR=ILAST
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15301     CONTINUE
15399     CONTINUE
          IENDF1='OFF'
          IREWI1='ON'
          CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,
     1                IPROT1,ICURS1,IENDF1,IREWI1,
     1                ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
          IF(IERRF1.EQ.'YES')GOTO9000
        ENDIF
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:16)='begin{document}'
        NCSTR=16
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=' '
        NCSTR=1
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ELSE
        ICSTR(1:1)=IBASLC
        ICSTR(2:14)='end{verbatim}'
        NCSTR=14
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ENDIF
C
C  DEFINE GRAY SCALE COLORS
C
      IF(ILATCO.EQ.'ON')THEN
        NCHTOT=5
        NCHDEC=3
        DO15110I=0,9
          ICSTR(1:1)=IBASLC
          ICSTR(2:25)='definecolor{G   }{gray}{'
          NCSTR=25
          WRITE(ICSTR(15:15),'(I1)')I
          ACOL=REAL(I)/100.0
          CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='}'
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15110   CONTINUE
        DO15120I=10,99
          ICSTR(1:1)=IBASLC
          ICSTR(2:25)='definecolor{G   }{gray}{'
          NCSTR=25
          WRITE(ICSTR(15:16),'(I2)')I
          ACOL=REAL(I)/100.0
          CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='}'
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15120   CONTINUE
        ICSTR(1:1)=IBASLC
        ICSTR(2:29)='definecolor{G100}{gray}{1.0}'
        NCSTR=29
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  IF COLOR SWITCH ON, DEFINE COLORS BASED ON RGB VALUES
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='WHIT'
        ARED=1.0
        AGREEN=1.0
        ABLUE=1.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BLAC'
        ARED=0.0
        AGREEN=0.0
        ABLUE=0.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='RED '
        ARED=1.0
        AGREEN=0.0
        ABLUE=0.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BLUE'
        ARED=0.0
        AGREEN=0.0
        ABLUE=1.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GREE'
        ARED=0.0
        AGREEN=1.0
        ABLUE=0.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MAGE'
        ARED=1.0
        AGREEN=0.0
        ABLUE=1.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORAN'
        ARED=1.0
        AGREEN=165.0/255.0
        ABLUE=0.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CYAN'
        ARED=0.0
        AGREEN=1.0
        ABLUE=1.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='YELL'
        ARED=1.0
        AGREEN=1.0
        ABLUE=0.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='YGRE'
        ARED=154.0/255.0
        AGREEN=205.0/255.0
        ABLUE=50.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DGRE'
        ARED=0.0/255.0
        AGREEN=100.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='LBLU'
        ARED=173.0/255.0
        AGREEN=216.0/255.0
        ABLUE=230.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='VBLU'
        ARED=138.0/255.0
        AGREEN=43.0/255.0
        ABLUE=226.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='VRED'
        ARED=208.0/255.0
        AGREEN=32.0/255.0
        ABLUE=144.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DGRE'
        ARED=47.0/255.0
        AGREEN=79.0/255.0
        ABLUE=79.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='LGRE'
        ARED=211.0/255.0
        AGREEN=211.0/255.0
        ABLUE=211.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='AQUA'
        ARED=127.0/255.0
        AGREEN=255.0/255.0
        ABLUE=212.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BROW'
        ARED=165.0/255.0
        AGREEN=42.0/255.0
        ABLUE=42.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CABL'
        ARED=95.0/255.0
        AGREEN=158.0/255.0
        ABLUE=160.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CORA'
        ARED=255.0/255.0
        AGREEN=127.0/255.0
        ABLUE=80.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CBLU'
        ARED=100.0/255.0
        AGREEN=149.0/255.0
        ABLUE=237.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DOGR'
        ARED=85.0/255.0
        AGREEN=107.0/255.0
        ABLUE=47.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DORC'
        ARED=153.0/255.0
        AGREEN=50.0/255.0
        ABLUE=204.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DSBL'
        ARED=72.0/255.0
        AGREEN=61.0/255.0
        ABLUE=139.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DTUR'
        ARED=0.0/255.0
        AGREEN=206.0/255.0
        ABLUE=209.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='FIRE'
        ARED=178.0/255.0
        AGREEN=34.0/255.0
        ABLUE=34.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='FGRE'
        ARED=34.0/255.0
        AGREEN=139.0/255.0
        ABLUE=34.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GOLD'
        ARED=255.0/255.0
        AGREEN=215.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GLDR'
        ARED=218.0/255.0
        AGREEN=165.0/255.0
        ABLUE=32.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GRAY'
        ARED=192.0/255.0
        AGREEN=192.0/255.0
        ABLUE=192.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='IRED'
        ARED=205.0/255.0
        AGREEN=92.0/255.0
        ABLUE=92.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='KHAK'
        ARED=240.0/255.0
        AGREEN=230.0/255.0
        ABLUE=140.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='DMGR'
        ARED=105.0/255.0
        AGREEN=105.0/255.0
        ABLUE=105.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='LSBL'
        ARED=176.0/255.0
        AGREEN=196.0/255.0
        ABLUE=222.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='LGRE'
        ARED=50.0/255.0
        AGREEN=205.0/255.0
        ABLUE=50.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MARO'
        ARED=176.0/255.0
        AGREEN=48.0/255.0
        ABLUE=96.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MAQU'
        ARED=102.0/255.0
        AGREEN=205.0/255.0
        ABLUE=170.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MBLU'
        ARED=0.0/255.0
        AGREEN=0.0/255.0
        ABLUE=205.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MFGR'
        ARED=107.0/255.0
        AGREEN=142.0/255.0
        ABLUE=35.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MGLD'
        ARED=250.0/255.0
        AGREEN=250.0/255.0
        ABLUE=210.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MORC'
        ARED=186.0/255.0
        AGREEN=85.0/255.0
        ABLUE=211.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MSGR'
        ARED=60.0/255.0
        AGREEN=179.0/255.0
        ABLUE=113.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MSBL'
        ARED=123.0/255.0
        AGREEN=104.0/255.0
        ABLUE=238.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MSPG'
        ARED=0.0/255.0
        AGREEN=250.0/255.0
        ABLUE=154.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MTUR'
        ARED=72.0/255.0
        AGREEN=209.0/255.0
        ABLUE=204.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MVRD'
        ARED=199.0/255.0
        AGREEN=21.0/255.0
        ABLUE=133.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MDBL'
        ARED=25.0/255.0
        AGREEN=25.0/255.0
        ABLUE=112.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='NAVY'
        ARED=0.0/255.0
        AGREEN=0.0/255.0
        ABLUE=128.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORED'
        ARED=255.0/255.0
        AGREEN=69.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORCH'
        ARED=218.0/255.0
        AGREEN=112.0/255.0
        ABLUE=214.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='PGRE'
        ARED=152.0/255.0
        AGREEN=251.0/255.0
        ABLUE=152.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='PINK'
        ARED=255.0/255.0
        AGREEN=192.0/255.0
        ABLUE=203.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='PLUM'
        ARED=221.0/255.0
        AGREEN=160.0/255.0
        ABLUE=221.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='PURP'
        ARED=160.0/255.0
        AGREEN=32.0/255.0
        ABLUE=240.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SALM'
        ARED=250.0/255.0
        AGREEN=128.0/255.0
        ABLUE=114.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SGRE'
        ARED=46.0/255.0
        AGREEN=139.0/255.0
        ABLUE=87.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SIEN'
        ARED=160.0/255.0
        AGREEN=82.0/255.0
        ABLUE=45.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SKBL'
        ARED=135.0/255.0
        AGREEN=206.0/255.0
        ABLUE=235.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SBLU'
        ARED=106.0/255.0
        AGREEN=90.0/255.0
        ABLUE=205.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='SPGR'
        ARED=0.0/255.0
        AGREEN=255.0/255.0
        ABLUE=127.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='STBL'
        ARED=70.0/255.0
        AGREEN=130.0/255.0
        ABLUE=180.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='TAN '
        ARED=210.0/255.0
        AGREEN=180.0/255.0
        ABLUE=140.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='THIS'
        ARED=216.0/255.0
        AGREEN=191.0/255.0
        ABLUE=216.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='TURQ'
        ARED=64.0/255.0
        AGREEN=224.0/255.0
        ABLUE=208.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='VIOL'
        ARED=238.0/255.0
        AGREEN=130.0/255.0
        ABLUE=238.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='WHEA'
        ARED=245.0/255.0
        AGREEN=222.0/255.0
        ABLUE=179.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GYEL'
        ARED=173.0/255.0
        AGREEN=255.0/255.0
        ABLUE=47.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='LCYA'
        ARED=224.0/255.0
        AGREEN=255.0/255.0
        ABLUE=255.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BLU2'
        ARED=0.0/255.0
        AGREEN=0.0/255.0
        ABLUE=238.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BLU3'
        ARED=0.0/255.0
        AGREEN=0.0/255.0
        ABLUE=205.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='BLU4'
        ARED=0.0/255.0
        AGREEN=0.0/255.0
        ABLUE=139.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CYA2'
        ARED=0.0/255.0
        AGREEN=238.0/255.0
        ABLUE=238.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CYA3'
        ARED=0.0/255.0
        AGREEN=205.0/255.0
        ABLUE=205.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='CYA4'
        ARED=0.0/255.0
        AGREEN=139.0/255.0
        ABLUE=139.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GRE2'
        ARED=0.0/255.0
        AGREEN=238.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GRE3'
        ARED=0.0/255.0
        AGREEN=205.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='GRE4'
        ARED=0.0/255.0
        AGREEN=139.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='YEL2'
        ARED=238.0/255.0
        AGREEN=238.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='YEL3'
        ARED=205.0/255.0
        AGREEN=205.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='YEL4'
        ARED=139.0/255.0
        AGREEN=139.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORA2'
        ARED=238.0/255.0
        AGREEN=154.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORA3'
        ARED=205.0/255.0
        AGREEN=133.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='ORA4'
        ARED=139.0/255.0
        AGREEN=90.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='RED2'
        ARED=238.0/255.0
        AGREEN=0.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='RED3'
        ARED=205.0/255.0
        AGREEN=0.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='RED4'
        ARED=139.0/255.0
        AGREEN=0.0/255.0
        ABLUE=0.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MAG2'
        ARED=238.0/255.0
        AGREEN=0.0/255.0
        ABLUE=238.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MAG3'
        ARED=205.0/255.0
        AGREEN=0.0/255.0
        ABLUE=205.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:1)=IBASLC
        ICSTR(2:24)='definecolor{    }{rgb}{'
        NCSTR=24
        ICSTR(14:17)='MAG4'
        ARED=139.0/255.0
        AGREEN=0.0/255.0
        ABLUE=139.0/255.0
        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=','
        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='}'
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ENDIF
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL DPCONA(34,IQUOTE)
      ISVGOS='ON'
      ISVGCN=0
C
      ICSTR(1:14)='<?xml version='
      ICSTR(15:15)=IQUOTE
      ICSTR(16:18)='1.0'
      ICSTR(19:19)=IQUOTE
      ICSTR(20:31)=' standalone='
      ICSTR(32:32)=IQUOTE
      ICSTR(33:34)='no'
      ICSTR(35:35)=IQUOTE
      ICSTR(36:37)='?>'
      NCSTR=-37
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(ISVGSS(1:3).EQ.'EXT')THEN
        NCSTR=22
        ICSTR(1:NCSTR)='<?xml-stylesheet href='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCTEMP=1
        DO16001I=80,1,-1
          NCTEMP=I
          IF(ISVGSN(I:I).NE.' ')GOTO16003
16001   CONTINUE
16003   CONTINUE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGSN(1:NCTEMP)
        NCSTR=NCSTR+NCTEMP
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=22
        ICSTR(1:NCSTR)='                 type='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+7)='text/css'
        NCSTR=NCSTR+8
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)='?>'
        NCSTR=-(NCSTR+1)
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ENDIF
C
      ICSTR(1:21)='<!DOCTYPE svg PUBLIC '
      ICSTR(22:22)=IQUOTE
      ICSTR(23:45)='-//W3C//DTD SVG 1.0//EN'
      ICSTR(46:46)=IQUOTE
      NCSTR=-46
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='     '
      ICSTR(6:6)=IQUOTE
      ICSTR(7:49)='http://www.w3.org./TR/2001/PR-SVG-20010719/'
      ICSTR(50:62)='DTD/svg10.dtd'
      ICSTR(63:63)=IQUOTE
      ICSTR(64:64)='>'
      NCSTR=-64
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      NCHTOT=6
      IXTEMP=ANUMHP
      IYTEMP=ANUMVP
C
      ICSTR(1:11)='<svg width='
      ICSTR(12:12)=IQUOTE
      NCSTR=12
      CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+7)=' height='
      NCSTR=NCSTR+8
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:13)='     viewBox='
      ICSTR(14:14)=IQUOTE
      ICSTR(15:18)='0 0 '
      NCSTR=18
      CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='>'
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:9)='   <desc>'
      NCSTR=-9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:47)='   SVG GRAPHIC CREATED BY DATAPLOT: MARCH, 2002'
      ICSTR(48:56)=' VERSION.'
      NCSTR=-56
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:10)='   </desc>'
      NCSTR=-10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:9)='   <g id='
      ICSTR(10:10)=IQUOTE
      ICSTR(11:25)='dataplot graph1'
      ICSTR(26:26)=IQUOTE
      ICSTR(27:27)='>'
      NCSTR=-27
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  CREATE BACKGROUND VIA FILLED RECTANGLE
C
      ICSTR(1:11)='   <rect x='
      NCSTR=-11
      ICSTR(12:12)=IQUOTE
      ICSTR(13:13)='0'
      ICSTR(14:14)=IQUOTE
      ICSTR(15:17)=' y='
      ICSTR(18:18)=IQUOTE
      ICSTR(19:19)='0'
      ICSTR(20:20)=IQUOTE
      NCSTR=-20
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:15)='         width='
      ICSTR(16:16)=IQUOTE
      NCSTR=16
      CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+7)=' height='
      NCSTR=NCSTR+8
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      CALL GRTRCO('BACK',IBACCO,JCOL)
C
      ICSTR(1:17)='           style='
      ICSTR(18:18)=IQUOTE
      ICSTR(19:31)='stroke:none; '
      NCSTR=-31
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:19)='             fill:#'
      NCSTR=19
      NCHTOT=2
      JTEMP=JCOL
      IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
      JRED=IRED(JTEMP)
      CALL DPCONX(JRED,ICJUNK)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
      NCSTR=NCSTR+1
      JGREEN=IGREEN(JTEMP)
      CALL DPCONX(JGREEN,ICJUNK)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
      NCSTR=NCSTR+1
      JBLUE=IBLUE(JTEMP)
      CALL DPCONX(JBLUE,ICJUNK)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
      NCSTR=NCSTR+2
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='   />'
      NCSTR=-5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'INDE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRINDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRMOBE(PX,PY)
C
C     PURPOSE--MOVE THE BEAM TO THE POINT (PX,PY)
C              ON A SPECIFIC GRAPHICS DEVICE.
C     NOTE--THE COORDINATES IN (PX,PY) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE DRIVER
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. UPDATE TO GENERAL CODED FOR GUI
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF TYPE (XYCOORD)   WXY
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*1 ICARAT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='MOBE'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOBE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRMOBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)PX,PY
   57 FORMAT('PX,PY = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3300
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **   STEP 11--                                      **
C               **   TREAT THE TEKTRONIX CASE                       **
C               ******************************************************
C
 1100 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (PORTRAIT, SQUARE ORIENTATIONS)
      IF(NUMVPP.GE.3000)IFACTO=1
      ICSTR(1:1)=IGSC
      NCSTR=1
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTIONS      **
C               **  AND PACKED BINARY COORDINATES                   **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 81, 253.                        **
C               ******************************************************
C
 2100 CONTINUE
      ICSTR(1:1)='p'
      NCSTR=1
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  USE THE PU (= PEN UP)                           **
C               **  AND PA (= PLOT ABSOLUTE) INSTRUCTION            **
C               **  ALONG WITH INTEGER COORDINATES                  **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 62, 143.                        **
C               **             PAGE 65-67, 143.                     **
C               ******************************************************
C
 2200 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2211)IX,IY
C2211 FORMAT('PU;PA',I5,',',I5,';')
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-12, 10-13.                       **
C               **********************************************************
C
 2300 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pa'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(16:16)='Z'
      NCSTR=16
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  MOVE -- ESCC &a#H  - HORIZONTAL POSITION IN DOTS    **
C               **          ESCC &a#V  - VERTICAL POSITION IN DOTS      **
C               **  REFERENCE-- LASERJET SERIES II TECHNICAL            **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **********************************************************
C
 2600 CONTINUE
      PYTEMP=100.-PY
      CALL GRTRSD(PX,PYTEMP,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='&a'
      NCSTR=3
      NCHTOT=4
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)='H'
      ICSTR(9:9)=IESCC
      ICSTR(10:11)='&a'
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(15:15)='V'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)PX,PY
C3111 FORMAT('MOVE TO ',F10.5,2X,F10.5)
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
C  MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIV POINTS IF THEY
C  ARE IDENTICAL.
C
 3200 CONTINUE
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
C
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3290
C
 3250 CONTINUE
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
      IPX=INT(AX*10.**IGENFA+0.5)
      IPY=INT(AY*10.**IGENFA+0.5)
      CALL GRTRIN(IPX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPY,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3290 CONTINUE
C
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
C               ***************************************************************
C
 3300 CONTINUE
      ICSTR(1:6)='LINE '
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:28)=';'
      NCSTR=28
C NOTE: CGM HAS NO "MOVE" COMMAND.  USING LINE WITH ONLY THE COORDINATES
C       FOR THE FIRST POINT DOES NOT OFFICIALLY CONFORM TO THE STANDARD
C       (ALTHOUGH MOST TRANSLATORS WILL PROBABLY HANDLE IT).  HOWEVER,
C       THIS ROUTINE USUALLY ONLY CALLED TO POSTION THE CURSOR, E.G. AT
C       THE END OF A PLOT, SO NO HARM TO SIMPLY IGNORE THIS INSTRUCTION.
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINE          **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRMOBE TO MOVE BEAM  CALCOMP DEVICE')
CCCCC ICSTR(1:50)='FIX SUBROUTINE GRMOBE TO MOVE BEAM  CALCOMP DEVICE'
CCCCC NCSTR=50
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
      IPEN=3
      CALL PLOT(PXA,PYA,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
      IPEN=3
      CALL PLOT(PXA,PYA,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
CQWVF CALL MOVETO(INT2(IX),INT2(IY),WXY)
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
CINTE CALL IGrMoveTo(REAL(IX),REAL(IY))
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
CWINT CALL IGrMoveTo(REAL(IX),REAL(IY))
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  USE THE 1 OP CODE (= PEN UP) AND                **
C               **  THE VECTOR PLOT (A TO X + COOR) OP CODES        **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE THE CALCOMP LIBRARY ROUTINES
C               ******************************************************
C
 5100 CONTINUE
CCCCC ICSTR(1:1)='1'
CCCCC NCSTR=1
CCCCC CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
      IPEN=3
      CALL PLOT(PXA,PYA,IPEN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRMOBE TO MOVE BEAM  RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRMOBE TO MOVE BEAM RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRMOBE TO MOVE BEAM  XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRMOBE TO MOVE BEAM XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO MOVE BEAM (= MOVE PEN)--                     **
C               **  USE THE P[ (= POSITION) COMMAND                 **
C               **  ALONG WITH INTEGER COORDINATES                  **
C               **  WITH A   TRAILING ]                             **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGE 101                             **
C               ******************************************************
C
 8100 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      ICSTR(1:2)='P['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  1)  XCOOR  YCOOR  MOVETO                        **
C               **  2)  STROKE                                      **
C               **  REFERENCE: POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
C               ******************************************************
C
 8600 CONTINUE
      ICSTR(1:8)='newpath '
      NCSTR=8
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:33)=' moveto stroke'
      NCSTR=33
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  1) ^IVvvvvv- VERTICAL POSITION RELATIVE TO TOP  **
C               **               OF PAGE (QUICPT WILL ADD MARGIN)   **
C               **  2) ^IHhhhhh- HORIZONTAL POSITION RELATIVE TO    **
C               **               LEFT OF PAGE                       **
C               **  REFERENCE: QUIC PROGRAMMING MANUAL              **
C               **  PAGES: 6-9, 6-12                                **
C               ******************************************************
C
 9100 CONTINUE
      CALL DPCONA(94,ICARAT)
      PYTEMP=100.-PY
      CALL QUICPT(PX,PYTEMP,IX1,IY1,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IV'
      NCSTR=3
      NCHTOT=-5
      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
      ICSTR(9:9)=ICARAT
      ICSTR(10:11)='IH'
      NCHTOT=-5
      NCSTR=11
      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
      NCSTR=16
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE - NULL ROUTINE        **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCMOTO(PX,PY)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  NULL ROUTINE                                    **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
      AX1=REAL(IX)
      AY1=REAL(IY)
CAQUA CALL aqtMoveTo(AX1,AY1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MOBE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRMOBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PX,PY
 9017 FORMAT('PX,PY = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GROPDE
C
C     PURPOSE--OPEN A SPECIFIC GRAPHICS DEVICE.
C              THAT IS, TURN ON (= EMPOWER) A DEVICE WHICH IS
C              CURRENTLY OFF.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989. SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE DRIVER
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF TYPE (QWINFO)   WINFO
CQWVF TYPE (FONTINFO) MSFONT
CQWVF TYPE (XYCOORD) XY
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      CHARACTER*1 ICARAT
CCCCC CHARACTER*1 IQUOTE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   MAY 1991.
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='OPDE'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPDE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GROPDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
   56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IPPDE1,IPPDE2
   61 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)NCPREP
   62 FORMAT('NCPREP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREP.LE.0)GOTO65
      DO63I=1,NCPREP
      WRITE(ICOUT,64)I,ICPREP(I:I)
   64 FORMAT('I,ICPREP(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
   65 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 0--                              **
C               **  IF CALLED FOR, WRITE OUT              **
C               **  A USER-DEFINED PRE-PLOT LINE          **
C               ********************************************
C
      IF(IPPDE1.EQ.'ANY')GOTO501
      IF(IPPDE1.EQ.'ALL')GOTO501
      GOTO509
  501 CONTINUE
      IF(NCPREP.GE.1)GOTO502
      GOTO509
  502 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
  509 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
CCCCC IF(IMODEL.EQ.'4662')GOTO1100
CCCCC GOTO9000
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4662 CASE (A PENPLOTTER)--  **
C               **  TO TURN IT ON,                                  **
C               **  WRITE OUT AN ESCAPE A E  .                      **
C               ******************************************************
C
 1100 CONTINUE
C
      IF(IPPDE1.EQ.'TEKT')GOTO1101
      GOTO1109
 1101 CONTINUE
      IF(NCPREP.GE.1)GOTO1102
      GOTO1109
 1102 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1109 CONTINUE
C
CCCCC IF(IMODEL.EQ.'4662')GOTO1110
CCCCC GOTO1119
C1110 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC
C1111 FORMAT(A1,'AE')
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='AE'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C1119 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (WITH PACKED BINARY)                            **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO TURN IT ON,                                  **
C               **  SEND ESCAPE PERIOD LEFT-PARENTHESIS             **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 72, 221-249.                    **
C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
C               **  TAKE ON HARDWARE DEFAULT                        **
C               **  (X = 520 TO 15720 MACHINE UNITS                 **
C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
C               **  ALSO ALLOW THE PLOTTER UNITS                    **
C               **  (= PLOTTER "RESOLUTION") TO                     **
C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
C               **  3040 UNITS IN THE X DIRECTION AND               **
C               **  2000 UNITS IN THE Y DIRECTION                   **
C               ******************************************************
C
 2100 CONTINUE
C
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'7221')GOTO2101
      GOTO2109
 2101 CONTINUE
      IF(NCPREP.GE.1)GOTO2102
      GOTO2109
 2102 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2109 CONTINUE
C
C     THE FOLLOWING 8 LINES WERE COMMENTED OUT
C     TO BE REPLACED BY STRINGS WHICH THE PLOT21 SOFTWARE
C     GENERATES FOR MIKE MCCABE'S HP-7221 PLOTTER.
CCCCC WRITE(IGUNIT,2111)IESCC
C2111 FORMAT(A1,'.(','}')
CCCCC WRITE(IGUNIT,2113)IESCC
C2113 FORMAT(A1,'.M100;13:','}')
CCCCC WRITE(IGUNIT,2114)IESCC
C2114 FORMAT(A1,'.I25;;17:','}')
CCCCC WRITE(IGUNIT,2117)IESCC
C2117 FORMAT(A1,'.K','}')
CCCCC WRITE(IGUNIT,2111)IESCC,IESCC
C2111 FORMAT(1H+,A1,'.Y',A1,'.(',':')
      ICSTR(1:8)='+Z.YZ.(:'
      ICSTR(2:2)=IESCC
      ICSTR(5:5)=IESCC
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2112)IESCC
C2112 FORMAT(1H+,A1,'.J',':')
      ICSTR(1:5)='+Z.J:'
      ICSTR(2:2)=IESCC
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2113)IESCC
C2113 FORMAT(1H+,A1,'.M0050;010;010;013;000',':')
      ICSTR(1:25)='+Z.M0050;010;010;013;000:'
      ICSTR(2:2)=IESCC
      NCSTR=25
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2114)IESCC
C2114 FORMAT(A1,'.H0080;020;057;000',':')
CCCCC WRITE(IGUNIT,2114)IESCC
C2114 FORMAT(1H+,A1,'.I0080;000;017;000',':')
      ICSTR(1:21)='+Z.I0080;000;017;000:'
      ICSTR(2:2)=IESCC
      NCSTR=21
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2115)IESCC
C2115 FORMAT(A1,'.N0010;000;000',':')
CCCCC WRITE(IGUNIT,2115)IESCC
C2115 FORMAT(1H+,A1,'.N0010;019;000',':')
      ICSTR(1:17)='+Z.N0010;019;000:'
      ICSTR(2:2)=IESCC
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2116)IESCC
C2116 FORMAT(A1,'.@9999;002',':')
CCCCC WRITE(IGUNIT,2116)IESCC
C2116 FORMAT(1H+,A1,'.@9999;010',':')
CCCCC WRITE(IGUNIT,2116)IESCC
C2116 FORMAT(A1,'.@9999;002',':')
CCCCC ICSTR(1:13)='+Z.@9999;010:'
      ICSTR(1:13)='+Z.@9999;002:'
      ICSTR(2:2)=IESCC
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,2117)IDC4C
C2117 FORMAT(A1,':')
CCCCC WRITE(IGUNIT,2115)IESCC
C2115 FORMAT(A1,'.N;19:','}')
CCCCC WRITE(IGUNIT,2116)IESCC
C2116 FORMAT(A1,'.E')
CCCCC WRITE(IGUNIT,2116)IESCC
CCCCC WRITE(IGUNIT,2116)IESCC
CCCCC WRITE(IGUNIT,2121)
C2121 FORMAT('~W`@@@@o(B2H}')
CCCCC THE FOLLOWING 2 LINES WERE FIXED (SOFT-CODE BACKSLASH) APRIL 1989
CCCCC WRITE(IGUNIT,2122)IBASLC
C2122 FORMAT('~Sn6B',A1,'P}')
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO    TURN ON    INSTRUCTION PER SE,   **
C               **  BUT TO INITIALIZE IT,                           **
C               **  SEND    IN                                      **
C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 40, 141.                        **
C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
C               **  TAKE ON HARDWARE DEFAULT                        **
C               **  (X = 520 TO 15720 MACHINE UNITS                 **
C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
C               **  ALSO ALLOW THE PLOTTER UNITS                    **
C               **  (= PLOTTER "RESOLUTION") TO                     **
C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
C               **  3040 UNITS IN THE X DIRECTION AND               **
C               **  2000 UNITS IN THE Y DIRECTION                   **
C               ******************************************************
C
 2200 CONTINUE
C
      IF(IPPDE1.EQ.'HPGL')GOTO2201
      IF(IPPDE1.EQ.'HP-G')GOTO2201
      IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL')GOTO2201
      IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL+')GOTO2201
      GOTO2209
 2201 CONTINUE
      IF(NCPREP.GE.1)GOTO2202
      GOTO2209
 2202 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2209 CONTINUE
C
C     THE FOLLOWING WAS A SUGGESTED AUGMENTATION
C     (NBS'S YONG-KI KIM, MARCH, 1985)
C     WHEN THE PLOTTER IS CONNECTED IN SERIES
C     BETWEEN THE HOST AND THE TERMINAL,
C     AND THE PLOTTER NEEDS TO BE PUT IN A
C     LISTEN-AND-CAPTURE MODE
C     WHEN GENERATING A PLOT.
C     TO SPECIFY THIS, THE ANALYST
C     ENTERS THE COMMAND        HP-GL +
C     RATHER THAN THE USUAL     HP-GL
C
CCCCC IF(IMODE2.EQ.'+')GOTO2210
CCCCC GOTO2219
C2210 CONTINUE
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='.Y'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C2219 CONTINUE
C
C     THE FOLLOWING WAS COMMENTED OUT
C     ON THE SUGGESTION OF PETER VERDIER (DEC., 1984)
C
CCCCC ICSTR(1:3)='IN;'
CCCCC NCSTR=3
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-3, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
C
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2622')GOTO2301
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2623')GOTO2301
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2627')GOTO2301
      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2647')GOTO2301
      GOTO2309
 2301 CONTINUE
      IF(NCPREP.GE.1)GOTO2302
      GOTO2309
 2302 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2309 CONTINUE
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  LANDSCAPE ORIENTATION                               **
C               **  TO INITIATE DEVICE--                                **
C               **     STEP 1--                                         **
C               **  REFERENCE--                                         **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **********************************************************
C
 2600 CONTINUE
      IF(IPPDE1.EQ.'PCL')GOTO2601
      GOTO2609
 2601 CONTINUE
      IF(NCPREP.GE.1)GOTO2602
      GOTO2609
 2602 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2609 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C
      IF(IPPDE1.EQ.'GENE')GOTO3101
      GOTO3109
 3101 CONTINUE
      IF(NCPREP.GE.1)GOTO3102
      GOTO3109
 3102 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3109 CONTINUE
C
C3111 FORMAT('OPEN DEVICE')
      ICSTR(1:11)='OPEN DEVICE'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
C
      IF(IPPDE1.EQ.'CODE')GOTO3201
      GOTO3209
 3201 CONTINUE
      IF(NCPREP.GE.1)GOTO3202
      GOTO3209
 3202 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3209 CONTINUE
C
      ICSTR(1:4)='OPDE'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3300 CONTINUE
C
      IF(IPPDE1.EQ.'CGM ')GOTO3301
      GOTO3309
 3301 CONTINUE
      IF(NCPREP.GE.1)GOTO3302
      GOTO3309
 3302 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3309 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO TURN IT ON--                                 **
C               **  USE THE CALCOMP LIBRARY ROUTINES                **
C               **  (NULL ROUTINE)                                  **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GROPDE TO OPEN CALCOMP DEVICE')
CCCCC ICSTR(1:44)='FIX SUBROUTINE GROPDE TO OPEN CALCOMP DEVICE'
CCCCC NCSTR=44
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(ILAHSW.EQ.'OFF')THEN
        IX1=0
        IF(ILAHGR.EQ.'BIOS')THEN
          IX2=0
        ELSEIF(ILAHGR.EQ.'DIRE')THEN
          IX2=1
        ELSE
          IX2=1
        ENDIF
        IMODE=0
        CALL PLOTS(IX1,IX2,IMODE)
        ILAHSW='ON'
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
CQWVF  IRESLT=FOCUSQQ(99)
CQWVF  IRESLT=SETFONT('fh16w8b')
CQWVF  MODESTATUS=GETFONTINFO(MSFONT)
CQWVF  ICHRHT=MSFONT.PIXHEIGHT
CQWVF  ICHRWD=MSFONT.PIXWIDTH
CQWVF  IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
CQWVF  IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
CQWVF  IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)

CQWVF  NUMHPP=WINFO.W*ICHRWD
CQWVF  IF(NUMHPP.LE.100)NUMHPP=100
CQWVF  NUMVPP=WINFO.H*ICHRHT
CQWVF  IF(NUMVPP.LE.100)NUMVPP=100
CQWVF  ANUMHP=REAL(NUMHPP)
CQWVF  ANUMVP=REAL(NUMVPP)

CQWVF CALL SETVIEWORG(INT2(0),INT2(0),XY)
CQWVF CALL SETVIEWPORT(INT2(0),INT2(0),INT2(NUMHPP-1),INT2(NUMVPP-1))
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      CALL GLOPDE()
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
CCCCC IHAND2=1
CCCCC CALL WindowSelect(IHAND2)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO TURN IT ON--                                 **
C               **  WRITE OUT    ZZZZZZZZZZ                         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **   USE CALCOMP LIBRARY ROUTINES                   **
C               **   NULL ROUTINE                                   **
C               ******************************************************
C
 5100 CONTINUE
CCCCC WRITE(IGUNIT,5111)
C5111 FORMAT('ZZZZZZZZZZ')
CCCCC ICSTR(1:10)='ZZZZZZZZZZ'
CCCCC NCSTR=10
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO TURN IT ON--                                 **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GROPDE TO OPEN RAMTEK DEVICE')
      ICSTR(1:43)='FIX SUBROUTINE GROPDE TO OPEN RAMTEK DEVICE'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      IF(IPPDE1.EQ.'SUN')GOTO6601
      GOTO6609
 6601 CONTINUE
      IF(NCPREP.GE.1)GOTO6602
      GOTO6609
 6602 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 6609 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO TURN IT ON--                                 **
C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GROPDE TO OPEN XXXXXX DEVICE')
      ICSTR(1:43)='FIX SUBROUTINE GROPDE TO OPEN XXXXXX DEVICE'
      NCSTR=43
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO OPEN A DEVICE---                             **
C               **  WRITE OUT AN XX                                 **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES XX AND XXX                     ZZ
C               ******************************************************
C
 8100 CONTINUE
C
      IF(IPPDE1.EQ.'REGI')GOTO8101
      GOTO8109
 8101 CONTINUE
      IF(NCPREP.GE.1)GOTO8102
      GOTO8109
 8102 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8109 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 86                                         **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  SINCE POSTSCRIPT IS A PAGE ORIENTATED LANGUAGE, **
C               **  SET PAGE PARAMETERS IN GRERSC (ERASE SCREEN)    **
C               **  REFERENCE - POSTSCRIPT LANGUAGE TUTORIAL AND    **
C               **  COOKBOOK FROM ADOBE SYSTEMS, CHAPTER 6          **
C               ******************************************************
C
 8600 CONTINUE
C
      IF(IPPDE1.EQ.'POST')GOTO8601
      GOTO8609
 8601 CONTINUE
      IF(NCPREP.GE.1)GOTO8602
      GOTO8609
 8602 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8609 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91                                         **
C               **  TREAT THE QUIC CASE                             **
C               **  1) SET ORIENTATION - LANDSCAPE "^IOL"           **
C               **                       PORTRAIT  "^IOP"           **
C               **  2) SET MARGIN      - HORIZONTAL "^IHMlllllrrrrr **
C               **                     - VERTICAL   "^IVMtttttbbbbb **
C               **     NOTE: MARGINS WILL BE ENFORCED BY THE "OFFSET"*
C               **           AND NUMBER OF PICTURE POINTS.  USING   **
C               **           IHM, IHV CAUSES A FORM FEED WHEN IT IS **
C               **           REACHED.  WE ONLY WANT TO CLIP, NOT    **
C               **           START A NEW PAGE.                      **
C               **  REFERENCE: QUIC PROGRAMMING MANUAL FROM QMS     **
C               ******************************************************
C
 9100 CONTINUE
C
      IF(IPPDE1.EQ.'QUIC')GOTO9101
      GOTO9109
 9101 CONTINUE
      IF(NCPREP.GE.1)GOTO9102
      GOTO9109
 9102 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 9109 CONTINUE
C
      CALL DPCONA(94,ICARAT)
      ICSTR(1:1)=ICARAT
      ICSTR(2:4)='IOL'
C
      IF(IORNSW.EQ.'PORT')GOTO9110
CCCCC AXLEFT=IQUILM
CCCCC AXRGHT=11.*QUIPPI-IQUIRM
CCCCC AYTOP=IQUITM
CCCCC AYBOT=8.5*QUIPPI-IQUIBM
CCCCC AFACTH=11.*QUIPPI
CCCCC AFACTV=8.5*QUIPPI
      IX2=11000
      IY2=8500
      GOTO9120
C
 9110 CONTINUE
C
      ICSTR(4:4)='P'
CCCCC AXLEFT=IQU2LM
CCCCC AXRGHT=8.5*QUIPPI-IQU2RM
CCCCC AYTOP=IQU2TM
CCCCC AYBOT=11.*QUIPPI-IQU2BM
CCCCC AFACTH=8.5*QUIPPI
CCCCC AFACTV=11.*QUIPPI
      IX2=8500
      IY2=11000
C
 9120 CONTINUE
C
CCCCC AXLEFT=100.*AXLEFT/AFACTH
CCCCC AXRGHT=100.*AXRGHT/AFACTH
CCCCC AYTOP=100.*AYTOP/AFACTV
CCCCC AYBOT=100.*AYBOT/AFACTV
C
      ICSTR(5:5)=ICARAT
      ICSTR(6:8)='IMH'
CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5)
      IX=0
CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5)
CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5)
      IY=0
CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5)
      NCSTR=8
      NCHTOT=-5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
      ICSTR(19:19)=ICARAT
      ICSTR(20:22)='IMV'
      NCSTR=22
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
      NCSTR=32
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IPPDE1.EQ.'X11 ')GOTO9601
      GOTO9609
 9601 CONTINUE
      IF(NCPREP.GE.1)GOTO9602
      GOTO9609
 9602 CONTINUE
      NCSTR=NCPREP
      IF(NCSTR.GT.40)NCSTR=40
      ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 9609 CONTINUE
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCOPDE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CGKS  CALL GACWK(IGKSID)
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
C  NOTE: DO NOTHING HERE. SETUP NEXT PLOT IN GRERSC ROUTINE.
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'OPDE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GROPDE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IPPDE1,IPPDE2
 9031 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)NCPREP
 9032 FORMAT('NCPREP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREP.LE.0)GOTO9035
      DO9033I=1,NCPREP
      WRITE(ICOUT,9034)I,ICPREP(I:I)
 9034 FORMAT('I,ICPREP(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
 9033 CONTINUE
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRRESC(PXCOOR,PYCOOR)
C
C     PURPOSE--READ SCREEN COORDINATES
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C     UPDATED         --JULY     1996. LAHEY (ALAN)
C     UPDATED         --OCTOBER  1996. MICROSOFT QWIN (ALAN)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CCCCC FOLLOWING LINE FOR MICROSOFT FORTRAN
CQWIN USE DFLIB
CIVFO USE IFQWIN
C
      CHARACTER*1 IBCH
      CHARACTER*1 IBHIX
      CHARACTER*1 IBLOX
      CHARACTER*1 IBHIY
      CHARACTER*1 IBLOY
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XRDLOC
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='RESC'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'RESC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRRESC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IGUNIT
   54 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMHPP,NUMVPP,ANUMHP,ANUMVP
   56 FORMAT('NUMHPP,NUMVPP,ANUMHP,ANUMVP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)PXCOOR,PYCOOR
   57 FORMAT('PXCOOR,PYCOOR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'QWIN')GOTO1080
      IF(IMANUF.EQ.'AQUA')GOTO1091
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO9000
C
CCCCC IF(IMODEL.EQ.'4020')GOTO1200
CCCCC IF(IMODEL.EQ.'4022')GOTO1200
CCCCC IF(IMODEL.EQ.'4025')GOTO1200
CCCCC IF(IMODEL.EQ.'4027')GOTO1200
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1080 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
C               ************************************************************
C               **  STEP 11--                                             **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
C               **  TO READ THE SCREEN,                                   **
C               **  WRITE OUT AN ESCAPE SUB                               **
C               ************************************************************
C
 1100 CONTINUE
      IFACTO=4
      IF(NUMHPP.GE.4000)IFACTO=1
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1111)
 1111 FORMAT('IN GRRESC, ABOUT TO ENTER GRKICR...')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
      CALL GRKICR
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1112)
 1112 FORMAT('IN GRRESC, ABOUT TO WRITE OUT ESCAPE SUB...')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
CCCCC CALL GRWRIN(ISTR,NSTR)
CCCCC IF(IHOST1.EQ.'VAX')WRITE(IGUNIT,1113)ISYNC,IESCC,ISUBC,IUSC
C1113 FORMAT($,1H ,4A1)
CCCCC IF(IHOST1.NE.'VAX')WRITE(IGUNIT,1114)ISYNC,IESCC,ISUBC,IUSC
C1114 FORMAT(4A1)
      NCSTR=0
      IF(IHOST1.EQ.'VAX')NCSTR=NCSTR+1
      IF(IHOST1.EQ.'VAX')ICSTR(NCSTR:NCSTR)='$'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ISYNC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IESCC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ISUBC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IUSC
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1121)
C1121 FORMAT('IN GRRESC, ABOUT TO READ SCREEN...')
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
CCCCC READ(IRD,1122)IBCH,IBHIX,IBLOX,IBHIY,IBLOY
      READ(IRDGR,1122)IBCH,IBHIX,IBLOX,IBHIY,IBLOY
 1122 FORMAT(5A1)
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1123)
 1123 FORMAT('IN GRRESC, ABOUT TO ENTER GRKICR...')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
      CALL GRRECR
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1124)
 1124 FORMAT('IN GRRESC, AFTER READING SCREEN...')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,1125)IBCH,IBHIX,IBLOX,IBHIY,IBLOY
 1125 FORMAT('IBCH,IBHIX,IBLOX,IBUTE4,IBLOY = ',5A1)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')WRITE(ICOUT,1126)
 1126 FORMAT('IN GRRESC, ABOUT TO ENTER GRTRBY...')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')CALL DPWRST('XXX','BUG ')
      CALL TKTRBY(IBHIX,IBLOX,IBHIY,IBLOY,IFACTO,IXCOOR,IYCOOR)
C
      XCOOR=IXCOOR
      YCOOR=IYCOOR
      PXCOOR=100.0*(XCOOR/ANUMHP)
      PYCOOR=100.0*(YCOOR/ANUMVP)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
C               **  (NON-COLOR RASTER DEVICES).                     **
C               **  TO READ THE SCREEN,                             **
C               **  USE THE !XXX COMMAND                            **
C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-3.    **
C               ******************************************************
C
C1200 CONTINUE
CCCCC WRITE(IGUNIT,1210)
C1210 FORMAT('!XXX;')
CCCCC GOTO9000
C1290 CONTINUE
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      ICSTR(1:1)=IESCC
C
      ICSTR(2:5)='*dkZ'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(2:5)='*s4^'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      READ(IRD,2311)IXCOOR,IYCOOR
 2311 FORMAT(I6,1X,I6)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,2312)IXCOOR,IYCOOR
 2312 FORMAT('IXCOOR,IYCOOR = ',2I8)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      XCOOR=IXCOOR
      YCOOR=IYCOOR
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,2313)XCOOR,YCOOR,ANUMHP,ANUMVP
 2313 FORMAT('XCOOR,YCOOR,ANUMHP,ANUMVP = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      PXCOOR=100.0*(XCOOR/ANUMHP)
      PYCOOR=100.0*(YCOOR/ANUMVP)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,2314)PXCOOR,PYCOOR
 2314 FORMAT('PXCOOR,PYCOOR = ',2E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      ICSTR(2:5)='*dlZ'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE HEWLETT-PACKARD PCL   CASES           **
C               **  (ALL PLOTTERS THAT TAKE PCL   INSTRUCTIONS)     **
C               **  (LASER JET II)                                  **
C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('READ SCREEN')
      ICSTR(1:11)='READ SCREEN'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:4)='RESC'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
C               ***************************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO READ SCREEN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRRESC TO READ SCREEN CALCOMP DEVICE')
CCCCC ICSTR(1:51)='FIX SUBROUTINE GRRESC TO READ SCREEN CALCOMP DEVICE'
CCCCC NCSTR=51
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY          CASE                   **
C               ******************************************************
C
 4600 CONTINUE
CCCCC CALL WHERE(AX,AY,AFACT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QWIN CASE                   **
C               ******************************************************
C
 4700 CONTINUE
      WRITE(ICOUT,4711)
 4711 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4712)
 4712 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
      CALL DPWRST('XXX','BUG ')
      IX=0
      IY=0
CQWVF IRESLT=FOCUSQQ(99)
CQWVF MOUSEEVENT = MOUSE$RBUTTONDOWN .OR. MOUSE$LBUTTONDOWN
CQWVF IRESLT = WAITONMOUSEEVENT(MOUSEEVENT, KEYSTATE, IX, IY)
      PXCOOR=100.0*(REAL(IX)/ANUMHP)
      PYCOOR=100.0 - 100.0*(REAL(IY)/ANUMVP)
CQWVF IRESLT=FOCUSQQ(IPR)
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO READ SCREEN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRRESC TO READ SCREEN RAMTEK DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRRESC TO READ SCREEN RAMTEK DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO READ SCREEN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRRESC TO READ SCREEN XXXXXX DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRRESC TO READ SCREEN XXXXXX DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO READ THE SCREEN---                           **
C               **  WRITE OUT AN R(P)                               **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 158                            **
C               ******************************************************
C
 8100 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='Pp'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:7)='R(P(T))'
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      READ(IRD,8111)IXCOOR,IYCOOR
 8111 FORMAT(1X,I3,1X,I3)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,8112)IXCOOR,IYCOOR
 8112 FORMAT('IXCOOR,IYCOOR = ',2I8)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      XCOOR=IXCOOR
      YCOOR=IYCOOR
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,8113)XCOOR,YCOOR,ANUMHP,ANUMVP
 8113 FORMAT('XCOOR,YCOOR,ANUMHP,ANUMVP = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      PXCOOR=100.0*(XCOOR/ANUMHP)
      PYCOOR=100.0*(YCOOR/ANUMVP)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1WRITE(ICOUT,8114)PXCOOR,PYCOOR
 8114 FORMAT('PXCOOR,PYCOOR = ',2E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')
     1CALL DPWRST('XXX','BUG ')
C
      ICSTR(1:1)=IESCC
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      ICSTR(2:2)=IBASLC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE DICOMED    CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9699
      WRITE(ICOUT,9611)
 9611 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9612)
 9612 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
      CALL DPWRST('XXX','BUG ')
      CALL XRDLOC(IXCOOR,IYCOOR,IXERR)
      IF(IXERR.NE.1)GOTO9620
      WRITE(ICOUT,9621)
 9621 FORMAT(1X,'WARNING: X11 WINDOW DESTROYED, NOTHING DONE')
      CALL DPWRST('XXX','BUG ')
      PXCOOR=0.
      PYCOOR=0.
      GOTO9699
 9620 CONTINUE
      XCOOR=IXCOOR
      YCOOR=IYCOOR
      PXCOOR=100.0*(XCOOR/ANUMHP)
      PYCOOR=100.0*(YCOOR/ANUMVP)
      PYCOOR=100.0-PYCOOR
C
 9699 CONTINUE
C
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCRESC(X,Y)
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'RESC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRRESC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMANUF,IMODEL
 9013 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IGUNIT
 9014 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IXCOOR,IYCOOR
 9015 FORMAT('IXCOOR,IYCOOR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMHPP,NUMVPP,ANUMHP,ANUMVP
 9016 FORMAT('NUMHPP,NUMVPP,ANUMHP,ANUMVP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PXCOOR,PYCOOR
 9017 FORMAT('PXCOOR,PYCOOR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRRIBE
C
C     PURPOSE--RING THE BELL
C              OF A SPECIFIC GRAPHICS DEVICE,
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='RIBE'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'RIBE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRRIBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IGUNIT
   54 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO9000
C
      IF(IMODEL.EQ.'4020')GOTO1200
      IF(IMODEL.EQ.'4022')GOTO1200
      IF(IMODEL.EQ.'4025')GOTO1200
      IF(IMODEL.EQ.'4027')GOTO1200
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ************************************************************
C               **  STEP 11--                                             **
C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
C               **  TO RING THE BELL,                                     **
C               **  WRITE OUT AN ESCAPE BEL                               **
C               ************************************************************
C
 1100 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC,IBELC
C1111 FORMAT(2A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IBELC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
C               **  (NON-COLOR RASTER DEVICES).                     **
C               **  TO RING THE BELL,                               **
C               **  USE THE !BEL COMMAND                            **
C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-3.    **
C               ******************************************************
C
 1200 CONTINUE
CCCCC WRITE(IGUNIT,1210)
C1210 FORMAT('!BEL;')
      ICSTR(1:5)='!BEL;'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 3-12, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      ICSTR(1:1)=IBELC
      NCSTR=1
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL (LASER JET) CASE      **
C               **  REFERENCE--                                         **
C               **     LASERJET SERIES II PRINTER, TECHNICAL REFERENCE  **
C               **             MANUAL, CHAPTERS 4, 5, 8                 **
C               **********************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)
C3111 FORMAT('RING BELL')
      ICSTR(1:9)='RING BELL'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:4)='RIBE'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  UNSUPPORTED CGM FEATURE                                  **
C               ***************************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO RING BELL--                                  **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRRIBE RING BELL ON CALCOMP DEVICE')
CCCCC ICSTR(1:49)='FIX SUBROUTINE GRRIBE RING BELL ON CALCOMP DEVICE'
CCCCC NCSTR=49
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
CINTE CALL IScreenBell(' ')
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
CWINT CALL WindowBell(' ')
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO RING BELL--                                  **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRRIBE RING BELL ON RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRRIBE RING BELL ON RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               **  WRITTEN BY BILL ANDERSON                        **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO RING BELL--                                  **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRRIBE RING BELL ON XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRRIBE RING BELL ON XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO RING BELL--                                  **
C               **  WRITE OUT AN BEL                                  **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 44 AND 96                      **
C               ******************************************************
C
 8100 CONTINUE
      ICSTR(1:1)=IBELC
      NCSTR=1
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86                                         **
C               **  TREAT THE POSTSCRIPT  CASE                      **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 90--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCRIBE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'RIBE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRRIBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IESCC,IBELC
 9012 FORMAT('IESCC,IBELC = ',A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMANUF,IMODEL
 9013 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IGUNIT
 9014 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSAGR(ICODE,ISTRI2,NCSTR2,CTEMP,NCTEMP)
C
C     PURPOSE--IMPLEMENT THE SAVE PLOT, REPEAT PLT, CYCLE PLOT
C              COMMANDS
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97.8
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--AUGUST    1997.
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF LOGICAL MODESTATUS
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN2
CQWVF TYPE (QWINFO)   WINFO
CQWVF TYPE (QWINFO)   WINFO2
CQWVF TYPE (FONTINFO) MSFONT
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C
      LOGICAL IMSFLG
      CHARACTER*1 IA
      CHARACTER*4 ICODE
      CHARACTER*256 ISTRI2
      CHARACTER*128 CTEMP
      CHARACTER*8 CJUNK
C
      DIMENSION IADE(128)
      DIMENSION IADE2(128)
      DIMENSION IWIND(8)
C
      CHARACTER*4 IMANUF
      CHARACTER*4 IMODEL
C
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPM.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOBE.INC'
CCCCC FOLLOWING LINE ADDED OCTOBER 1997.
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA IMSFLG/.TRUE./
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SAGR'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IMANUF=IDMANU(1)
      IMODEL=IDMODE(1)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SAGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSAGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF
   52 FORMAT('IMANUF = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMODEL
   53 FORMAT('IMODEL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ICODE
   54 FORMAT('IMANUF,ICODE = ',I5)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
CPCL  IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      GOTO2100
C
 1020 CONTINUE
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      WRITE(ICOUT,1110)
 1110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR TEKTRONIX DEVICES.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD      CASE             **
C               ******************************************************
C
 2100 CONTINUE
      WRITE(ICOUT,2110)
 2110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR HP DEVICES.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      WRITE(ICOUT,3110)
 3110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR GENERAL DEVICES.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      WRITE(ICOUT,4110)
 4110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR CALCOMP DEVICES.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      WRITE(ICOUT,4610)
 4610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(ICODE.EQ.'SAVE')THEN

CQWVF   IRESLT=FOCUSQQ(99)
CQWVF   IRESLT=SETFONT('fh16w8b')
CQWVF   MODESTATUS=GETFONTINFO(MSFONT)
CQWVF   ICHRHT=MSFONT.PIXHEIGHT
CQWVF   ICHRWD=MSFONT.PIXWIDTH
CQWVF   IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
CQWVF   IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
CQWVF   IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)
C
CQWVF   NUMHPP=WINFO.W*ICHRWD
CQWVF   IF(NUMHPP.LE.100)NUMHPP=100
CQWVF   NUMVPP=WINFO.H*ICHRHT
CQWVF   IF(NUMVPP.LE.100)NUMVPP=100
CQWVF   ANUMHP=REAL(NUMHPP)
CQWVF   ANUMVP=REAL(NUMVPP)
CQWVF   IRESLT=SAVEIMAGE(ISTRI2,0,0,NUMHPP-1, NUMVPP-1)
      ELSEIF(ICODE.EQ.'CYCL')THEN
 4799   CONTINUE
        IERR=0
CQWVF   IRESLT=FOCUSQQ(98)
CQWVF   MOUSEEVENT = MOUSE$RBUTTONDOWN .OR. MOUSE$LBUTTONDOWN
CQWVF   IRESLT = WAITONMOUSEEVENT(MOUSEEVENT, KEYSTATE, IX, IY)
CQWVF   IF((MOUSE$KS_SHIFT.AND.KEYSTATE).EQ.MOUSE$KS_SHIFT)THEN
CQWVF     GOTO9000
CQWVF   ELSEIF((MOUSE$KS_CONTROL.AND.KEYSTATE).EQ.MOUSE$KS_CONTROL)THEN
CQWVF     GOTO9000
CQWVF   ELSEIF(IRESLT.EQ.MOUSE$KS_LBUTTON)THEN
CQWVF     ICURPM=ICURPM-1
CQWVF     IF(ICURPM.LT.1)ICURPM=1
CQWVF   ELSEIF(IRESLT.EQ.MOUSE$KS_RBUTTON)THEN
CQWVF     ICURPM=ICURPM+1
CQWVF     IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
CQWVF   ELSEIF(IRESLT.EQ.MOUSE$BADEVENT)THEN
CQWVF     GOTO9000
CQWVF   ELSE
CQWVF     GOTO9000
CQWVF   ENDIF
C
        NCSTR2=1
        DO4705I=128,1,-1
          NCSTR2=I
          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO4709
 4705   CONTINUE
 4709   CONTINUE
        CTEMP=' '
        IF(ICURPM.LE.9)THEN
          CTEMP(1:4)='  - '
          WRITE(CTEMP(1:1),'(I1)')ICURPM
          NCTEMP=4
        ELSEIF(ICURPM.LE.99)THEN
          CTEMP(1:5)='   - '
          WRITE(CTEMP(1:2),'(I2)')ICURPM
          NCTEMP=5
        ELSEIF(ICURPM.LE.999)THEN
          CTEMP(1:6)='    - '
          WRITE(CTEMP(1:3),'(I3)')ICURPM
          NCTEMP=6
        ENDIF
        NCHRS=80-NCTEMP
        NCTEMP=NCTEMP+1
        CTEMP(NCTEMP:80)=IPXMFN(ICURPM)(1:NCHRS)
        IF(IMSFLG)THEN
CQWVF     DPSCREEN2=DPSCREEN
CQWVF     WINFO2=WINFO
CQWVF     WINFO2.Y=0
CQWVF     DPSCREEN2.TITLE=CTEMP
CQWVF     OPEN(UNIT=98,FILE='USER',TITLE=CTEMP,
CQWVF1       IOFOCUS=.TRUE.)
C
CQWVF     MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
CQWVF     IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
CQWVF     ISTATUS=DISPLAYCURSOR($GCURSORON)
CQWVF     MODESTATUS=GETWINDOWCONFIG(DPSCREEN2)
CQWVF     IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO2)
C
CQWVF     IRESLT=SETWSIZEQQ(98,WINFO2)
CQWVF     IRESLT=GETWSIZEQQ(98,QWIN$SIZECURR,WINFO2)
C
CQWVF     IRESLT=FOCUSQQ(98)
        ENDIF
CQWVF   IRESLT=LOADIMAGE(IPXMFN(ICURPM),0,0)
        IMSFLG=.FALSE.
C
        GOTO4799
      ELSEIF(ICODE.EQ.'REST')THEN
        IF(IMSFLG)THEN
CQWVF     DPSCREEN2=DPSCREEN
CQWVF     WINFO2=WINFO
CQWVF     WINFO2.Y=0
CQWVF     DPSCREEN2.TITLE=CTEMP
CQWVF     OPEN(UNIT=98,FILE='USER',TITLE=CTEMP,
CQWVF1       IOFOCUS=.TRUE.)
C
CQWVF     MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
CQWVF     IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
CQWVF     ISTATUS=DISPLAYCURSOR($GCURSORON)
CQWVF     MODESTATUS=GETWINDOWCONFIG(DPSCREEN2)
CQWVF     IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO2)
C
CQWVF     IRESLT=SETWSIZEQQ(98,WINFO2)
CQWVF     IRESLT=GETWSIZEQQ(98,QWIN$SIZECURR,WINFO2)
C
CQWVF     IRESLT=FOCUSQQ(98)
        ENDIF
CQWVF   IRESLT=LOADIMAGE(ISTRI2,0,0)
CCCCC   IMSFLG=.FALSE.
      ENDIF
C
 4790 CONTINUE
CQWVF IRESLT=FOCUSQQ(IPR)
CQWVF IRESLT=DISPLAYCURSOR($GCURSORON)
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(ICODE.EQ.'SAVE')THEN
        DO4820I=1,NCSTR2
          CALL DPCOAN(ISTRI2(I:I),IJUNK)
          IADE(I)=IJUNK
 4820   CONTINUE
        IADE(NCSTR2+1)=0
C
        IERR=0
        CALL GLSAVG(IADE,IERR)
        IF(IERR.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4851)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 4851 FORMAT('***** ERROR IN DPSAPL--WRITING BIT MAP UNSUCCESSFUL.')
          ELSEIF(IERR.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4861)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
 4861 FORMAT('***** ERROR IN DPSAPL--NO CURRENT PIXMAP TO SAVE.')
        ELSEIF(IERR.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4871)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 4871 FORMAT('***** ERROR IN DPSAPL--OPEN-GL HAS NOT BEEN OPENED.')
        ELSEIF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4881)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 4881 FORMAT('***** ERROR IN DPSAPL--OPENGL NOT INSTALLED ON THIS ',
     1'IMPLEMENTATION.')
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4891)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4892)ISTRI2(1:NCSTR2)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 4891 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY SAVED TO FILE ')
 4892 FORMAT('      ',A128)
C
      ELSEIF(ICODE.EQ.'REST')THEN
        DO19729I=1,8
          IWIND(I)=-1
19729   CONTINUE
        ICOUNT=0
        IF(IX11W2.EQ.'        ')GOTO19739
        CJUNK(1:8)=IX11W2(1:8)
        ICOUNT=0
        DO19730I=8,1,-1
          IA=CJUNK(I:I)
          IF(IA.EQ.' ')GOTO19730
          ICOUNT=ICOUNT+1
          CALL DPCOAN(IA,IVALUE)
          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
            IWIND(ICOUNT)=IVALUE-48
          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
            IWIND(ICOUNT)=IVALUE-55
          ELSEIF(IVALUE.GE.197.AND.IVALUE.LE.102)THEN
            IWIND(ICOUNT)=IVALUE-87
          ELSE
            ICOUNT=1
            WRITE(ICOUT,19733)
            GOTO19739
          ENDIF
19730   CONTINUE
19733 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
19739   CONTINUE
        DO19715I=1,NCTEMP
          CALL DPCOAN(CTEMP(I:I),IADE2(I))
19715   CONTINUE
        DO19720I=1,NCSTR2
          CALL DPCOAN(ISTRI2(I:I),IADE(I))
          CALL DPCOAN(ISTRI2(I:I),IADE2(I+NCTEMP))
19720   CONTINUE
        IADE(NCSTR2+1)=0
        IADE2(NCSTR2+NCTEMP+1)=0
C
        IERR=0
        CALL GLRESG(IADE,IADE2,IWIND,ICOUNT,IERR)
        IF(IERR.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19751)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19751 FORMAT('***** ERROR IN DPREGR--READING BIT MAP UNSUCCESSFUL.')
        ELSEIF(IERR.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19761)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19761 FORMAT('***** ERROR IN DPREGR--NO CURRENT PIXMAP TO SAVE.')
        ELSEIF(IERR.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19771)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19771 FORMAT('***** ERROR IN DPREGR--OPEN-GL HAS NOT BEEN OPENED.')
        ELSEIF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19781)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19781 FORMAT('***** ERROR IN DPREGR--OPEN-GL NOT INSTALLED ON THIS ',
     1'IMPLEMENTATION.')
        ELSEIF(IERR.EQ.5)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19786)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19786 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN NEW OPEN-GL ',
     1       'WINDOW ')
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19791)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,19792)ISTRI2(1:NCSTR2)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
19791 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY COPIED FROM FILE ')
19792 FORMAT('      ',A128)
        ENDIF
C
      ELSEIF(ICODE.EQ.'CYCL')THEN
14800   CONTINUE
        IERR=0
        CALL GLCYCL(IERR,IBUTTN)
        IF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IERR.NE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
14810 FORMAT('***** ERROR FROM DPCYGR: OPEN-GL NOT ACTIVE ON THIS ',
     1'IMPLEMENTATION.')
14811 FORMAT('***** ERROR FROM DPCYGR: ERROR TRYING TO REDRAW PIXMAP.')
        IF(IBUTTN.EQ.1)THEN
          ICURPM=ICURPM-1
          IF(ICURPM.LT.1)ICURPM=1
        ELSEIF(IBUTTN.EQ.3)THEN
          ICURPM=ICURPM+1
          IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
        ELSE
          GOTO9000
        ENDIF
C
        NCSTR2=1
        DO24805I=128,1,-1
          NCSTR2=I
          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO24809
24805   CONTINUE
24809   CONTINUE
        CTEMP=' '
        IF(ICURPM.LE.9)THEN
          CTEMP(1:4)='  - '
          WRITE(CTEMP(1:1),'(I1)')ICURPM
          NCTEMP=4
        ELSEIF(ICURPM.LE.248)THEN
          CTEMP(1:5)='   - '
          WRITE(CTEMP(1:2),'(I2)')ICURPM
          NCTEMP=5
        ELSEIF(ICURPM.LE.2489)THEN
          CTEMP(1:6)='    - '
          WRITE(CTEMP(1:3),'(I3)')ICURPM
          NCTEMP=6
        ENDIF
        DO24815I=1,NCTEMP
          CALL DPCOAN(CTEMP(I:I),IADE2(I))
24815 CONTINUE
        DO24820I=1,NCSTR2
          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE(I))
          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE2(I+NCTEMP))
24820 CONTINUE
        IADE(NCSTR2+1)=0
        IADE2(NCSTR2+NCTEMP+1)=0
        IERR=0
        DO24829I=1,8
          IWIND(I)=-1
24829   CONTINUE
        ICOUNT=0
        IF(IX11W2.EQ.'        ')GOTO24839
        CJUNK(1:8)=IX11W2(1:8)
        ICOUNT=0
        DO24830I=8,1,-1
          IA=CJUNK(I:I)
          IF(IA.EQ.' ')GOTO24830
          ICOUNT=ICOUNT+1
          CALL DPCOAN(IA,IVALUE)
          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
            IWIND(ICOUNT)=IVALUE-48
          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
            IWIND(ICOUNT)=IVALUE-55
          ELSEIF(IVALUE.GE.248.AND.IVALUE.LE.102)THEN
            IWIND(ICOUNT)=IVALUE-87
          ELSE
            ICOUNT=1
            WRITE(ICOUT,24833)
            GOTO24839
          ENDIF
24830   CONTINUE
24833 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
24839   CONTINUE
        CALL GLRESG(IADE,IADE2,IWIND,ICOUNT,IERR)
        IF(IERR.NE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        GOTO14800
      ENDIF
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      WRITE(ICOUT,4910)
 4910 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY INTERACTOR DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      WRITE(ICOUT,4960)
 4960 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY WINTERACTOR DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      WRITE(ICOUT,5110)
 5110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR ZETA DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 6600 CONTINUE
      WRITE(ICOUT,6610)
 6610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR SUN DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8100 CONTINUE
      WRITE(ICOUT,8110)
 8110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR REGIS DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8600 CONTINUE
      WRITE(ICOUT,8610)
 8610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR POSTSCRIPT DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9100 CONTINUE
      WRITE(ICOUT,9110)
 9110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR QUIC DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9600 CONTINUE
      IF(ICODE.EQ.'SAVE')THEN
        DO9620I=1,NCSTR2
          CALL DPCOAN(ISTRI2(I:I),IJUNK)
          IADE(I)=IJUNK
 9620   CONTINUE
        IADE(NCSTR2+1)=0
C
        IERR=0
        CALL XSAVEG(IADE,IERR)
        IF(IERR.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9651)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9651 FORMAT('***** ERROR IN DPSAPL--WRITING BIT MAP UNSUCCESSFUL.')
          ELSEIF(IERR.EQ.2)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9661)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
 9661 FORMAT('***** ERROR IN DPSAPL--NO CURRENT PIXMAP TO SAVE.')
        ELSEIF(IERR.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9671)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9671 FORMAT('***** ERROR IN DPSAPL--X11 HAS NOT BEEN OPENED.')
        ELSEIF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9681)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9681 FORMAT('***** ERROR IN DPSAPL--X11 NOT INSTALLED ON THIS ',
     1'IMPLEMENTATION.')
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9691)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9692)ISTRI2(1:NCSTR2)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 9691 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY SAVED TO FILE ')
 9692 FORMAT('      ',A128)
C
      ELSEIF(ICODE.EQ.'REST')THEN
        DO9729I=1,8
          IWIND(I)=-1
 9729   CONTINUE
        ICOUNT=0
        IF(IX11W2.EQ.'        ')GOTO9739
        CJUNK(1:8)=IX11W2(1:8)
        ICOUNT=0
        DO9730I=8,1,-1
          IA=CJUNK(I:I)
          IF(IA.EQ.' ')GOTO9730
          ICOUNT=ICOUNT+1
          CALL DPCOAN(IA,IVALUE)
          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
            IWIND(ICOUNT)=IVALUE-48
          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
            IWIND(ICOUNT)=IVALUE-55
          ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
            IWIND(ICOUNT)=IVALUE-87
          ELSE
            ICOUNT=1
            WRITE(ICOUT,9733)
            GOTO9739
          ENDIF
 9730   CONTINUE
 9733 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
 9739   CONTINUE
        DO9715I=1,NCTEMP
          CALL DPCOAN(CTEMP(I:I),IADE2(I))
 9715   CONTINUE
        DO9720I=1,NCSTR2
          CALL DPCOAN(ISTRI2(I:I),IADE(I))
          CALL DPCOAN(ISTRI2(I:I),IADE2(I+NCTEMP))
 9720   CONTINUE
        IADE(NCSTR2+1)=0
        IADE2(NCSTR2+NCTEMP+1)=0
C
        IERR=0
        CALL XRESTG(IADE,IADE2,IWIND,ICOUNT,IERR)
        IF(IERR.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9751)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9751 FORMAT('***** ERROR IN DPREGR--READING BIT MAP UNSUCCESSFUL.')
        ELSEIF(IERR.EQ.2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9761)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9761 FORMAT('***** ERROR IN DPREGR--NO CURRENT PIXMAP TO SAVE.')
        ELSEIF(IERR.EQ.3)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9771)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9771 FORMAT('***** ERROR IN DPREGR--X11 HAS NOT BEEN OPENED.')
        ELSEIF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9781)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9781 FORMAT('***** ERROR IN DPREGR--X11 NOT INSTALLED ON THIS ',
     1'IMPLEMENTATION.')
        ELSEIF(IERR.EQ.5)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9786)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9786 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN NEW X11 WINDOW ')
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9791)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9792)ISTRI2(1:NCSTR2)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 9791 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY COPIED FROM FILE ')
 9792 FORMAT('      ',A128)
        ENDIF
C
      ELSEIF(ICODE.EQ.'CYCL')THEN
 9800   CONTINUE
        IERR=0
        CALL XCYCLE(IERR,IBUTTN)
        IF(IERR.EQ.4)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(IERR.NE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 9810 FORMAT('***** ERROR FROM DPCYGR: X11 NOT ACTIVE ON THIS ',
     1'IMPLEMENTATION.')
 9811 FORMAT('***** ERROR FROM DPCYGR: ERROR TRYING TO REDRAW PIXMAP.')
        IF(IBUTTN.EQ.1)THEN
          ICURPM=ICURPM-1
          IF(ICURPM.LT.1)ICURPM=1
        ELSEIF(IBUTTN.EQ.3)THEN
          ICURPM=ICURPM+1
          IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
        ELSE
          GOTO9000
        ENDIF
C
        NCSTR2=1
        DO9905I=128,1,-1
          NCSTR2=I
          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO9909
 9905   CONTINUE
 9909   CONTINUE
        CTEMP=' '
        IF(ICURPM.LE.9)THEN
          CTEMP(1:4)='  - '
          WRITE(CTEMP(1:1),'(I1)')ICURPM
          NCTEMP=4
        ELSEIF(ICURPM.LE.99)THEN
          CTEMP(1:5)='   - '
          WRITE(CTEMP(1:2),'(I2)')ICURPM
          NCTEMP=5
        ELSEIF(ICURPM.LE.999)THEN
          CTEMP(1:6)='    - '
          WRITE(CTEMP(1:3),'(I3)')ICURPM
          NCTEMP=6
        ENDIF
        DO9915I=1,NCTEMP
          CALL DPCOAN(CTEMP(I:I),IADE2(I))
 9915 CONTINUE
        DO9920I=1,NCSTR2
          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE(I))
          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE2(I+NCTEMP))
 9920 CONTINUE
        IADE(NCSTR2+1)=0
        IADE2(NCSTR2+NCTEMP+1)=0
        IERR=0
        DO9929I=1,8
          IWIND(I)=-1
 9929   CONTINUE
        ICOUNT=0
        IF(IX11W2.EQ.'        ')GOTO9939
        CJUNK(1:8)=IX11W2(1:8)
        ICOUNT=0
        DO9930I=8,1,-1
          IA=CJUNK(I:I)
          IF(IA.EQ.' ')GOTO9930
          ICOUNT=ICOUNT+1
          CALL DPCOAN(IA,IVALUE)
          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
            IWIND(ICOUNT)=IVALUE-48
          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
            IWIND(ICOUNT)=IVALUE-55
          ELSEIF(IVALUE.GE.99.AND.IVALUE.LE.102)THEN
            IWIND(ICOUNT)=IVALUE-87
          ELSE
            ICOUNT=1
            WRITE(ICOUT,9933)
            GOTO9939
          ENDIF
 9930   CONTINUE
 9933 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
 9939   CONTINUE
        CALL XRESTG(IADE,IADE2,IWIND,ICOUNT,IERR)
        IF(IERR.NE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9810)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        GOTO9800
      ENDIF
C
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
C               *************************************************
C
10000 CONTINUE
      WRITE(ICOUT,10110)
10110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR VGA DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      WRITE(ICOUT,11110)
11110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR GKS DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      WRITE(ICOUT,12110)
12110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR GD (=JPEG, PNG, WBMP) DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      WRITE(ICOUT,13110)
13110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR MACINTOSH DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      WRITE(ICOUT,14110)
14110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
     1'GRAPH COMMANDS NOT SUPPORTED FOR PC PRINTER DEVICE.')
      CALL DPWRST('XXXX','BUG')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SAGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSAGR--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSECA(ITYPE,ICASE,JCASE)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A CASE (UPPER OR LOWER)
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ITYPE
      CHARACTER*4 ICASE
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SECA'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SECA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSECA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ITYPE
   52 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASE
   53 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      WRITE(IGUNIT,3111)ICASE
 3111 FORMAT('SET CASE ',A4)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:5)='SECA '
      ICSTR(6:9)=ICASE
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM       CASE                        **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCSECA(ICASE)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SECA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSECA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ITYPE
 9012 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASE,JCASE
 9013 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSECO(ICASE,ICOL,JCOL)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A COLOR
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --JULY     1990. SUPPORT COLOR FOR SOME HP-2622 DEVICES
C     UPDATED         --JANUARY  1991. SUPPORT COLOR ON REGIS (ALAN)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --APRIL    1992. FIX DEBUG CODE
C     UPDATED         --AUGUST   1992. POSTSCRIPT TO HANDLE FULL SET OF
C                                      COLORS (ALAN)
C     UPDATED         --MARCH    1993. POSTSCRIPT (HANDLE GRAY SCALE
C                                      DIFFERENTLY ON BLACK AND WHITE
C                                      AND COLOR DEVICES)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --LATEK    2006. LATEX COLOR
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC ADD FOLLOWING LINE OCTOBER 1996.
CQWIN USE DFLIB
CIVFO USE IFQWIN
C
      CHARACTER*4 ICASE
      CHARACTER*4 ICOL
C
      CHARACTER*1 ICOL2
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      INTEGER RD(8),GN(8),BE(8)
      INTEGER RED(8),GRN(8),BLE(8)
C  AUGUST 1992.  ADD FOLLOWING 2 LINES
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XFORE
C
C  AUGUST 1992.  DEFINE COLORS FOR POSTSCRIPT (CGM SETS COLOR TABLE
C  IN GRINDE AND GRERSC).
C
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SECO'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      JCOL2=0
      ICOL2=' '
C
      IUNIT=(-999)
      ITEN=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SECO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICOL
   53 FORMAT('ICOL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGUNIT
   55 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C        ********************************************
C        **  STEP 1--                              **
C        **  BRANCH ACCORDING TO THE MANUFACTURER  **
C        **  AND THE MODEL                         **
C        ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO1100
C
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
C        ******************************************************
C        **  STEP 11--                                       **
C        **  TREAT THE TEKTRONIX 4662                        **
C        **  (A PENPLOTTER).                                 **
C        **  REFERENCE--XXX                                  **
C        ******************************************************
C
 1100 CONTINUE
C
CCCCC IF(ICASE.EQ.'LINE')GOTO1110
CCCCC IF(ICASE.EQ.'REGI')GOTO1120
CCCCC IF(ICASE.EQ.'MARK')GOTO1110
CCCCC IF(ICASE.EQ.'TEXT')GOTO1130
CCCCC GOTO1110
C
 1110 CONTINUE
CCCCC WRITE(IGUNIT,1111)IESCC,JCOL
C1111 FORMAT(A1,'ABP',I1)
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='ABP'
      IX=JCOL+48
CCCCC ICSTR(5:5)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(5:5))
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C1120 CONTINUE
CCCCC IF(JCOL.EQ.0)JCOL2=48
CCCCC IF(JCOL.NE.0)JCOL2=JCOL+32
CCCCC ICOL2=CHAR(JCOL2)
CCCCC WRITE(IGUNIT,1121)IESCC,ICOL2
C1121 FORMAT(A1,'MP',A1)
CCCCC GOTO9000
C
C1130 CONTINUE
CCCCC WRITE(IGUNIT,1131)IESCC,JCOL
C1131 FORMAT(A1,'MT',I1)
CCCCC GOTO9000
C
CCCCC GOTO9000
C
C        ******************************************************
C        **  STEP 12--                                       **
C        **  TREAT THE TEKTRONIX 4027                        **
C        **  (COLOR RASTER DEVICE).                          **
C        **  REFERENCE--XXX                                  **
C        ******************************************************
C
 1200 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO1210
      IF(ICASE.EQ.'REGI')GOTO1210
      IF(ICASE.EQ.'MARK')GOTO1210
      IF(ICASE.EQ.'TEXT')GOTO1220
      IF(ICASE.EQ.'BACK')GOTO1210
      IF(ICASE.EQ.'FORE')GOTO1210
      GOTO1220
C
 1210 CONTINUE
CCCCC WRITE(IGUNIT,1211)JCOL
C1211 FORMAT('!COL C',I1)
      ICSTR(1:6)='!COL C'
      IX=JCOL+48
CCCCC ICSTR(7:7)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(7:7))
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1220 CONTINUE
CCCCC WRITE(IGUNIT,1221)JCOL
C1221 FORMAT('!ATT C',I1)
      ICSTR(1:6)='!ATT C'
      IX=JCOL+48
CCCCC ICSTR(7:7)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(7:7))
      NCSTR=7
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 13--                                       **
C        **  TREAT THE TEKTRONIX 4105                        **
C        **  (COLOR RASTER DEVICE).                          **
C        **  REFERENCE--PAGE 5-45 (LINE), 5-50 (TEXT),       **
C        **             5-32 (REGION)                        **
C        ******************************************************
C
 1300 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO1310
      IF(ICASE.EQ.'REGI')GOTO1320
      IF(ICASE.EQ.'MARK')GOTO1310
      IF(ICASE.EQ.'TEXT')GOTO1330
      IF(ICASE.EQ.'BACK')GOTO1320
      IF(ICASE.EQ.'FORE')GOTO1310
      GOTO1310
C
 1310 CONTINUE
CCCCC WRITE(IGUNIT,1311)IESCC,JCOL
C1311 FORMAT(A1,'ML',I1)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='ML'
      IX=JCOL+48
CCCCC ICSTR(4:4)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(4:4))
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1320 CONTINUE
      IF(JCOL.EQ.0)JCOL2=48
      IF(JCOL.NE.0)JCOL2=JCOL+32
CCCCC ICOL2=CHAR(JCOL2)
      CALL DPCONA(JCOL2,ICOL2)
CCCCC WRITE(IGUNIT,1321)IESCC,ICOL2
C1321 FORMAT(A1,'MP',A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='MP'
      IX=JCOL+48
CCCCC ICSTR(4:4)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(4:4))
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1330 CONTINUE
CCCCC WRITE(IGUNIT,1331)IESCC,JCOL
C1331 FORMAT(A1,'MT',I1)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='MT'
      IX=JCOL+48
CCCCC ICSTR(4:4)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(4:4))
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 21--                                       **
C        **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C        **  (MULTI-COLOR PENPLOTTER)                        **
C        **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C        **             OPERATING AND PROGRAMMING MANUAL,    **
C        **             PAGE 73.                             **
C        ******************************************************
C
 2100 CONTINUE
      JCOL2=JCOL+64
CCCCC ICOL2=CHAR(JCOL2)
      CALL DPCONA(JCOL2,ICOL2)
CCCCC WRITE(IGUNIT,2111)ICOL2
C2111 FORMAT('v',A1,'}')
      ICSTR(1:1)='v'
      ICSTR(2:2)=ICOL2
      ICSTR(3:3)='}'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 22--                                       **
C        **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C        **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C        **  (MULTI-COLOR PENPLOTTERS)                       **
C        **  TO SET COLOR--                                  **
C        **  WRITE OUT A    SP     PEN NUMBER                **
C        **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
C        **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C        **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C        **             OPERATING AND PROGRAMMING MANUAL,    **
C        **             PAGE 61, 144.                        **
C        ******************************************************
C
 2200 CONTINUE
CCCCC WRITE(IGUNIT,2211)JCOL
C2211 FORMAT('SP',I1,';')
      ICSTR(1:2)='SP'
      IX=JCOL+48
CCCCC ICSTR(3:3)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(3:3))
      ICSTR(4:4)=';'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        **********************************************************
C        **  STEP 23--                                           **
C        **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C        **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C        **  (MONOCHROME DISPLAY TERMINALS)                      **
C        **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C        **             REFERENCE MANUAL,                        **
C        **             PAGE XX-X, XXX.                          **
C        **********************************************************
C
 2300 CONTINUE
      IF(IGCOLO.NE.'ON')GOTO9000
      IF(ICASE.EQ.'BACK')GOTO9000
      GOTO2310
C
 2310 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*m'
      NCSTR=3
      NCHTOT=1
      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='X'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 26--                                       **
C        **  TREAT THE PCL CASE (LASERJET PRINTER)           **
C        **  REFERENCE--LASERJET SERIES II TECHNICAL REFERENCE*
C        **             MANUAL                               **
C        ******************************************************
C
 2600 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO2690
      IF(ICASE.EQ.'REGI')GOTO2620
      IF(ICASE.EQ.'MARK')GOTO2690
      IF(ICASE.EQ.'TEXT')GOTO2690
      IF(ICASE.EQ.'BACK')GOTO2690
      IF(ICASE.EQ.'FORE')GOTO2690
      GOTO2690
C
C  VALUE OF JCOL WILL BE UTILIZED IN GRFIRE TO SIMULATE COLOR FOR
C  SOLID FILL PATTERNS (BY DOT DENSITY).  NOTHING DONE HERE.
C
 2620 CONTINUE
      GOTO2690
C
 2690 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 31--                                       **
C        **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C        ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)ICASE,ICOL
C3111 FORMAT('SET COLOR ',A4,2X,A4)
C  NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
      IF(ICASE.EQ.'BACK')GOTO9000
      ICSTR(1:10)='SET COLOR '
      ICSTR(11:14)=ICASE
      ICSTR(15:16)='  '
      ICSTR(17:20)=ICOL
      NCSTR=20
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ***************************************************************
C        **  STEP 32--                                                **
C        **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C        ***************************************************************
C
 3200 CONTINUE
C  NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
      IF(ICASE.EQ.'BACK')GOTO9000
      ICSTR(1:5)='SECO '
      ICSTR(6:9)=ICASE
      ICSTR(10:10)=' '
      ICSTR(11:14)=ICOL
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 33--                                       **
C        **  TREAT THE CGM CASE                              **
C        ******************************************************
C
 3300 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO3310
      IF(ICASE.EQ.'REGI')GOTO3320
      IF(ICASE.EQ.'MARK')GOTO3330
      IF(ICASE.EQ.'TEXT')GOTO3330
      IF(ICASE.EQ.'BACK')GOTO3340
      IF(ICASE.EQ.'FORE')GOTO3310
      GOTO3310
C
 3310 CONTINUE
      ICSTR(1:9)='LINECOLR '
      NCHTOT=2
      NCSTR=9
      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:12)=';'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3390
C
 3320 CONTINUE
      ICSTR(1:9)='FILLCOLR '
      NCHTOT=2
      NCSTR=9
      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:12)=';'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3390
C
 3330 CONTINUE
      ICSTR(1:9)='TEXTCOLR '
      NCHTOT=2
      NCSTR=9
      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
      ICSTR(12:12)=';'
      NCSTR=12
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3390
C
C  NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
 3340 CONTINUE
      GOTO3390
C
 3390 CONTINUE
      GOTO9000
C
C        ***************************************************
C        **  STEP 34--                                    **
C        **  TREAT THE CGM (BINARY)                 CASE  **
C        ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 41--                                       **
C        **  TREAT THE CALCOMP XXXXXX CASE                   **
C        **  TO SET COLOR--                                  **
C        **  WRITE OUT AN XXXXXXXXXX                         **
C        **  (NOT DONE)                                      **
C        **  REFERENCE--XX                                   **
C        **             XX                                   **
C        **             PAGES XX AND XX                      **
C        **  USE CALCOMP LIBRARY ROUTINES                    **
C        ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRSECO TO SET COLOR CALCOMP DEVICE')
CCCCC ICSTR(1:49)='FIX SUBROUTINE GRSECO TO SET COLOR CALCOMP DEVICE'
CCCCC NCSTR=49
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICASE.EQ.'BACK')GOTO4190
      IF(JCOL.EQ.ICALCC)GOTO4190
      CALL NEWPEN(JCOL)
      ICALCC=JCOL
 4190 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 46--                                       **
C        **  TREAT THE LAHEY   XXXXXX CASE                   **
C        **  REFERENCE--Programmer's Reference, Revision C   **
C        **             Lahey Computer Systems, January, 1992**
C        **             PAGES 51 THRU 65                     **
C        ******************************************************
C
 4600 CONTINUE
      IF(ICASE.EQ.'BACK')GOTO4690
      IF(JCOL.EQ.ILAHCC)GOTO4690
      CALL NEWPEN(JCOL)
      ILAHCC=JCOL
 4690 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 47--                                       **
C        **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C        **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C        ******************************************************
C
 4700 CONTINUE
      IF(ICASE.EQ.'BACK')GOTO4790
      IF(IQWNCL.EQ.'VGA')THEN
CQWVF   ISTATUS=SETCOLOR(INT2(JCOL))
      ELSEIF(IQWNCL.EQ.'RGB')THEN
        IF(JCOL.GE.0)THEN
CQWVF     JTEMP=RGBTOINTEGER(IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
CQWVF     ISTATUS=SETCOLORRGB(JTEMP)
        ELSE
          AVAL=ABS(REAL(JCOL)/100.)*255.
          IVAL=INT(AVAL+0.5)
          IF(IVAL.LT.0)IVAL=0
          IF(IVAL.GT.255)IVAL=255
          JTEMP=IVAL
CQWVF     JTEMP2=RGBTOINTEGER(JTEMP,JTEMP,JTEMP)
CQWVF     ISTATUS=SETCOLORRGB(JTEMP2)
        ENDIF
      ELSE
CQWVF   ISTATUS=SETCOLOR(INT2(JCOL))
      ENDIF
 4790 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 48--                                       **
C        **  TREAT THE OPEN-GL DRIVER                        **
C        **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C        ******************************************************
C
 4800 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4810
      IF(ICASE.EQ.'REGI')GOTO4810
      IF(ICASE.EQ.'MARK')GOTO4810
      IF(ICASE.EQ.'TEXT')GOTO4810
      IF(ICASE.EQ.'BACK')GOTO4890
      IF(ICASE.EQ.'FORE')GOTO4810
      GOTO 4810
C
 4810 CONTINUE
      ATEMP=255.0
      ARED=REAL(IRED(JCOL))/ATEMP
      AGREEN=REAL(IGREEN(JCOL))/ATEMP
      ABLUE=REAL(IBLUE(JCOL))/ATEMP
      CALL GLSECO(JCOL,ARED,AGREEN,ABLUE)
      GOTO 4890
C
 4890 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 49--                                       **
C        **  TREAT THE LAHEY INTERACTOR CASE                 **
C        ******************************************************
C
 4900 CONTINUE
CINTE CALL IGrColourN(JCOL)
      GOTO9000
C
C        ******************************************************
C        **  STEP 49B-                                       **
C        **  TREAT THE LAHEY WINTERACTOR CASE                **
C        ******************************************************
C
 4950 CONTINUE
      IF(ICASE.EQ.'BACK')GOTO9000
      IF(JCOL.LT.0)THEN
        AVAL=REAL(JCOL)/100.
        AVAL=ABS(AVAL)
        IF(AVAL.LE.0.0)AVAL=0.0
        IF(AVAL.GE.1.0)AVAL=1.0
        ITEMP=INT(255.*AVAL + 0.5)
        IJUNK=MAXCLR+1
        IF(IWINCL.EQ.'RGB')THEN
CWINT     CALL IGrPaletteRGB(IJUNK,ITEMP,ITEMP,ITEMP)
CWINT     CALL IGrColourN(IJUNK)
        ELSE
CWINT     CALL IGrColourN(2)
        ENDIF
      ELSE
CWINT   CALL IGrColourN(JCOL)
      ENDIF
      GOTO9000
C
C
C        ******************************************************
C        **  STEP 51--                                       **
C        **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C        **  TO SET COLOR--                                  **
C        **  WRITE OUT A    71 TO 74     OP CODE             **
C        **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C        **             MODELS 3600SX AND 3653SX             **
C        **             PAGES B-0 AND B-1                    **
C        **  USE CALCOMP LIBRARY ROUTINES                    **
C        ******************************************************
C
 5100 CONTINUE
CCCCC WRITE(IGUNIT,5111)JCOL
C5111 FORMAT(I2)
CCCCC ITEN=JCOL/10
CCCCC ITEN48=ITEN+48
CCCCC ICSTR(1:1)=CHAR(ITEN48)
CCCCC CALL DPCONA(ITEN48,ICSTR(1:1))
CCCCC IUNIT=JCOL-10*ITEN
CCCCC IUNI48=IUNIT+48
CCCCC ICSTR(2:2)=CHAR(IUNI48)
CCCCC CALL DPCONA(IUNI48,ICSTR(2:2))
CCCCC NCSTR=2
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICASE.EQ.'BACK')GOTO9000
      IF(IZETCC.EQ.JCOL)GOTO5190
      CALL NEWPEN(JCOL)
      IZETCC=JCOL
 5190 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 61--                                       **
C        **  TREAT THE RAMTEK XXXXXX CASE                    **
C        **  TO SET COLOR--                                  **
C        **  WRITE OUT AN XXXXXXXXXX                         **
C        **  (NOT DONE)                                      **
C        **  REFERENCE--XX                                   **
C        **             XX                                   **
C        **             PAGES XX AND XX                      **
C        ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRSECO TO SET COLOR RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRSECO TO SET COLOR RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 66--                                       **
C        **  TREAT THE SUN CASE                              **
C        ******************************************************
C
 6600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO6620
      IF(ICASE.EQ.'REGI')GOTO6640
      IF(ICASE.EQ.'MARK')GOTO6620
      IF(ICASE.EQ.'TEXT')GOTO6630
      IF(ICASE.EQ.'BACK')GOTO6610
      IF(ICASE.EQ.'FORE')GOTO6620
      GOTO6620
C
 6610 CONTINUE
C   BLACK(I.E. 'DARK')
      RD(1) = 0
      GN(1) = 0
      BE(1) = 0
C    RED
      RD(2) = 244
      GN(2) = 9
      BE(2) = 6
C    GREEN
      RD(3) = 50
      GN(3) = 198
      BE(3) = 12
C    BLUE
      RD(4) = 120
      GN(4) = 215
      BE(4) = 247
C    YELLOW
      RD(5) = 254
      GN(5) = 241
      BE(5) = 108
C    ORANGE
C        RD(6) = 245
C        GN(6) = 176
C        BE(6) = 33
C    BLACK
      RD(6) = 0
      GN(6) = 0
      BE(6) = 0
C    PURPLE
      RD(7) = 189
      GN(7) = 102
      BE(7) = 249
C    WHITE
      RD(8) = 255
      GN(8) = 255
      BE(8) = 255
      RED(1) = RD(JCOL+1)
      GRN(1) = GN(JCOL+1)
      BLE(1) = BE(JCOL+1)
      DO 6605 I =2,8
         RED(I) = RD(I)
         GRN(I) = GN(I)
         BLE(I) = BE(I)
 6605 CONTINUE
CSUN  CALL cfcotable(0,RED,GRN,BLE,8)
      GOTO6690
C
 6620 CONTINUE
CSUN  CALL cflncolor(JCOL)
      GOTO6690
C
 6630 CONTINUE
CSUN  CALL cftextcolor(JCOL)
      GOTO6690
C
 6640 CONTINUE
CSUN  CALL cfflcolor(JCOL)
      GOTO6690
C
 6690 CONTINUE
      GOTO 9000
C
C        ******************************************************
C        **  STEP 71--                                       **
C        **  TREAT THE XXXXXX  XXXXXX CASE                   **
C        **  TO SET COLOR--                                  **
C        **  WRITE OUT AN XXXXXXXXXX                         **
C        **  (NOT DONE)                                      **
C        **  REFERENCE--XX                                   **
C        **             XX                                   **
C        **             PAGES XX AND XX                      **
C        ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRSECO TO SET COLOR XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRSECO TO SET COLOR XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 81--                                       **
C        **  TREAT THE REGIS CASE                            **
C        **  ADD SUPPORT FOR COLOR (JANUARY, 1991).  SPECIFY **
C        **  THE COLOR BY HLS VALUE.  THESE VALUES ARE STORED**
C        **  IN AN ARRAY.  REGIS SUPPORTS 64 HLS COLORS (AT  **
C        **  LEAST ON THE VT-240, DON'T KNOW IF MORE RECENT  **
C        **  MODELS SUPPORT MORE).  THESE 64 COLORS ARE      **
C        **  FIXED (I.E., CAN'T REDEFINE AVAILABLE COLORS).  **
C        **  NOTE THAT REGIS ALLOWS 4 COLOR MAP LOCATIONS TO **
C        **  BE DEFINED.  WE USE LOCATION 0 FOR THE          **
C        **  BACKGROUND COLOR AND LOCATIONS 1 THRU 3 FOR THE **
C        **  FOREGROUND COLOR.  THE M1 COMMAND DEFINES THE   **
C        **  COLOR AND COMMAND W(I1) SPECIFIES WHICH COLOR   **
C        **  MAP.                                            **
C        ******************************************************
C
 8100 CONTINUE
      IF(IGCOLO.NE.'ON')GOTO9000
      IF(ICASE.EQ.'BACK')GOTO9000
      GOTO8110
C
 8110 CONTINUE
      DO8115I=1,IREGMC
        IF(JCOL.EQ.IREGPM(I))THEN
          IMAP=I
          GOTO8116
        END IF
 8115 CONTINUE
      IMAP=IREGMC
 8116 CONTINUE
      ICSTR(1:27)='S(M  (AH   L   S   ))W(I  )'
      NCHTOT=2
      NCSTR=3
      CALL GRTRIN(IMAP,NCHTOT,ICSTR,NCSTR)
      NCSTR=24
      CALL GRTRIN(IMAP,NCHTOT,ICSTR,NCSTR)
      NCHTOT=3
      ITEMP=IRGHUE(JCOL)
      NCSTR=8
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ITEMP=IRGLGT(JCOL)
      NCSTR=12
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ITEMP=IRGSAT(JCOL)
      NCSTR=16
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=27
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C        ******************************************************
C        **  STEP 86--                                       **
C        **  TREAT THE POSTSCRIPT CASE                       **
C        **  INDEX BY THE USER, THE OTHERS ONLY BY INDEX     **
C        ******************************************************
C  AUGUST 1992.  UPDATED TO HANDLE COLORS CONSISTENTLY WITH OTHER
C  DEVICES.  POSTSCRIPT ALLOWS RGB VALUES TO BE SET DIRECTLY.  USE
C  COLOR DEFINITIONS PROVIDED IN "XLIB PROGRAMMERS MANUAL" FROM
C  O'REILLY.  ALSO, SUPPORT GRAY SCALE FOR BOTH COLOR AND BLACK AND
C  WHITE POSTSCRIPT.
C
 8600 CONTINUE
C
CCCCC IF(IGCOLO.NE.'ON')GOTO9000
      IF(ICASE.EQ.'BACK')GOTO9000
CCCCC GOTO8610
C
C8610 CONTINUE
CCCCC IF(JCOL.EQ.0)ICSTR(1:26)='0.   0.   0.   setrgbcolor'
CCCCC IF(JCOL.EQ.1)ICSTR(1:26)='1.   0.   0.   setrgbcolor'
CCCCC IF(JCOL.EQ.2)ICSTR(1:26)='0.   1.   0.   setrgbcolor'
CCCCC IF(JCOL.EQ.3)ICSTR(1:26)='1.   1.   0.   setrgbcolor'
CCCCC IF(JCOL.EQ.4)ICSTR(1:26)='0.   0.   1.   setrgbcolor'
CCCCC IF(JCOL.EQ.5)ICSTR(1:26)='1.   0.   1.   setrgbcolor'
CCCCC IF(JCOL.EQ.6)ICSTR(1:26)='0.   1.   1.   setrgbcolor'
CCCCC IF(JCOL.EQ.7)ICSTR(1:26)='1.   1.   1.   setrgbcolor'
CCCCC IF(JCOL.EQ.8)ICSTR(1:26)='1.   0.5  0.   setrgbcolor'
CCCCC IF(JCOL.EQ.9)ICSTR(1:26)='0.5  1.   0.   setrgbcolor'
CCCCC IF(JCOL.EQ.10)ICSTR(1:26)='0.   1.   0.5  setrgbcolor'
CCCCC IF(JCOL.EQ.11)ICSTR(1:26)='0.   0.5  1.   setrgbcolor'
CCCCC IF(JCOL.EQ.12)ICSTR(1:26)='0.5  0.   1.   setrgbcolor'
CCCCC IF(JCOL.EQ.13)ICSTR(1:26)='1.   0.   0.5  setrgbcolor'
CCCCC IF(JCOL.EQ.14)ICSTR(1:26)='0.33 0.33 0.33 setrgbcolor'
CCCCC IF(JCOL.EQ.15)ICSTR(1:26)='0.66 0.66 0.66 setrgbcolor'
CCCCC NCSTR=26
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(JCOL.LT.0)THEN
CCCCC   MARCH 1993.  HANDLE BLACK AND WHITE DEVICES DIFFERENTLY THAN
CCCCC   COLOR DEVICES.
        IF(IGCOLO.EQ.'ON')THEN
          AVAL=REAL(JCOL)/100.
          AVAL=ABS(AVAL)
          IF(AVAL.LE.0.0)AVAL=0.0
          IF(AVAL.GE.1.0)AVAL=1.0
          NCSTR=0
          NCHTOT=7
          NCHDEC=5
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+10
          ICSTR(NCSTR:NCSTR2)='setrgbcolor'
          NCSTR=NCSTR2
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC   MARCH 1993.  ADD FOLLOWING SECTION.
        ELSE
          AVAL=REAL(JCOL)/100.
          AVAL=ABS(AVAL)
          IF(AVAL.LE.0.0)AVAL=0.0
          IF(AVAL.GE.1.0)AVAL=1.0
          NCSTR=0
          NCHTOT=7
          NCHDEC=5
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+6
          ICSTR(NCSTR:NCSTR2)='setgray'
          NCSTR=NCSTR2
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        END IF
      ELSE
CCCCC   MARCH 1993.  FOR BLACK AND WHITE DEVICES, BE SURE TO RESET
CCCCC   GRAY SCALE.
CCCCC   IF(IGCOLO.NE.'ON')GOTO9000
        IF(IGCOLO.EQ.'ON')THEN
          AVAL=REAL(IRED(JCOL))/255.
          NCSTR=0
          NCHTOT=7
          NCHDEC=5
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          AVAL=REAL(IGREEN(JCOL))/255.
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          AVAL=REAL(IBLUE(JCOL))/255.
          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=' '
          NCSTR=NCSTR+1
          NCSTR2=NCSTR+10
          ICSTR(NCSTR:NCSTR2)='setrgbcolor'
          NCSTR=NCSTR2
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC     MARCH 1993.  ADD FOLLOWING SECTION.
        ELSE
          ICSTR(1:10)='0. setgray'
          NCSTR=10
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
      ENDIF
      GOTO9000
C
C        ******************************************************
C        **  STEP 89--                                       **
C        **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C        ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 91--                                       **
C        **  TREAT THE QUIC CASE                             **
C        ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C        ******************************************************
C        **  STEP 96--                                       **
C        **  TREAT THE X11     CASE                          **
C        ******************************************************
C
 9600 CONTINUE
C
      IF(IX11OF.EQ.'OFF')GOTO9000
      IF(ICASE.EQ.'LINE')GOTO9610
      IF(ICASE.EQ.'REGI')GOTO9610
      IF(ICASE.EQ.'MARK')GOTO9610
      IF(ICASE.EQ.'TEXT')GOTO9610
      IF(ICASE.EQ.'BACK')GOTO9690
      IF(ICASE.EQ.'FORE')GOTO9610
      GOTO9610
C
 9610 CONTINUE
      CALL XFORE(JCOL)
      GOTO9690
C
 9690 CONTINUE
      GOTO9000
C
C        *************************************************
C        **  STEP 100--                                 **
C        **  TREAT THE VGA VIA TURBO-C       CASE       **
C        **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C        **             ENHANCEMENTS, PAGE 122.         **
C        **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C        **             PAGE 309-310, 312-313.          **
C        *************************************************
C
10000 CONTINUE
C
      IF(ITCST.EQ.'CLOS')GOTO9000
      CALL TCSECO(ICASE,ICOL)
      GOTO9000
C
C        ******************************************************
C        **  STEP 110--                                      **
C        **  TREAT THE GKS                DRIVER             **
C        ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C       ******************************************************
C       **  STEP 120--                                      **
C       **  TREAT THE GD                     DRIVER         **
C       **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C       **  1) JPEG                                         **
C       **  2) PNG                                          **
C       **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C       **  NOTE: COLOR PASSED TO DRAWING ROUTINES          **
C       ******************************************************
C
12000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO12010
      IF(ICASE.EQ.'REGI')GOTO12010
      IF(ICASE.EQ.'MARK')GOTO12010
      IF(ICASE.EQ.'TEXT')GOTO12010
      IF(ICASE.EQ.'BACK')GOTO12090
      IF(ICASE.EQ.'FORE')GOTO12010
      GOTO12010
C
12010 CONTINUE
      CALL GDSECO(JCOL)
      GOTO12090
C
12090 CONTINUE
      GOTO9000
C
C         ******************************************************
C         **  STEP 130--                                      **
C         **  TREAT THE MACINTOSH              DRIVER         **
C         **  LIBRARY FROM ABSOFT COMPILER                    **
C         ******************************************************
C
13000 CONTINUE
      IFACT=1
      IF(ICASE.EQ.'LINE')GOTO13010
      IF(ICASE.EQ.'REGI')GOTO13010
      IF(ICASE.EQ.'MARK')GOTO13010
      IF(ICASE.EQ.'TEXT')GOTO13010
      IF(ICASE.EQ.'BACK')GOTO13090
      IF(ICASE.EQ.'FORE')GOTO13010
      GOTO13010
C
13010 CONTINUE
      ITEMP=1
      IR=IFACT*IRED(JCOL)
      IG=IFACT*IGREEN(JCOL)
      IB=IFACT*IBLUE(JCOL)
CMACI CALL SetMyColor(ITEMP,IR,IG,IB)
      GOTO13090
C
13090 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
C  NOTE: COLOR CAN SET EITHER FROM COLOR MAP TABLE OR BY SETTING
C        RGB VALUES DIRECTLY.  FOR INITIAL IMPLEMENTATION, WE WILL
C        USE THE COLORMAP METHOD, BUT INCLUDE CODE DIRECT METHOD
C        IN CASE THAT PROVES MORE EFFECTIVE.
C
13500 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO13510
      IF(ICASE.EQ.'REGI')GOTO13510
      IF(ICASE.EQ.'MARK')GOTO13510
      IF(ICASE.EQ.'TEXT')GOTO13510
      IF(ICASE.EQ.'BACK')GOTO13590
      IF(ICASE.EQ.'FORE')GOTO13510
      GOTO13510
C
13510 CONTINUE
CAQUA CALL aqtTakeColorFromColormapEntry(JCOL)
CCCCC AR=REAL(IRED(JCOL))/255.
CCCCC AG=REAL(IGREEN(JCOL))/255.
CCCCC AB=REAL(IBLUE(JCOL))/255.
CCCCC CALL aqtSetColor(AR,AG,AB)
      GOTO13590
C
13590 CONTINUE
      GOTO9000
C
C         ******************************************************
C         **  STEP 140--                                      **
C         **  TREAT THE PC PRINTER             DRIVER         **
C         ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      IF(ILATCO.EQ.'ON')THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:12)='color{    }'
        ICSTR(8:11)=ICOL(1:4)
        NCSTR=12
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        GOTO9000
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SECO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICOL,JCOL
 9013 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)JCOL2,ICOL2
 9014 FORMAT('JCOL2,ICOL2 = ',I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IMANUF,IMODEL
 9015 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IX
 9016 FORMAT('IX = ',I8)
      CALL DPWRST('XXX','BUG ')
C  APRIL 1992.  FOLLOWING 2 LINES MODIFIED
CCCCC WRITE(ICOUT,9017)JCOL,ITEN,IUNIT,ITEN48,IUNI48
C9017 FORMAT('JCOL,ITEN,IUNIT,ITEN48,IUNI48 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)JCOL,ITEN,IUNIT
 9017 FORMAT('JCOL,ITEN,IUNIT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IGUNIT
 9018 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEDI(ICASE,IDIR,ANGLE,JDIR,ANGLE2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A DIRECTION
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IDIR
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEDI'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEDI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDIR,ANGLE
   53 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)JDIR,ANGLE2
   54 FORMAT('JDIR,ANGLE2 = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IMANUF,IMODEL
   55 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IGUNIT
   56 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-19, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:6)='*m1nZ'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)IDIR
C3111 FORMAT('SET DIRECTION ',A4)
      ICSTR(1:14)='SET DIRECTION '
      ICSTR(15:18)=IDIR
      NCSTR=18
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,3112)ANGLE
C3112 FORMAT('SET ANGLE ',F10.5)
      ICSTR(1:10)='SET ANGLE '
      NCSTR=10
      X=ANGLE
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(X,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:5)='SEDI '
      ICSTR(6:9)=IDIR
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='SEAN '
      NCSTR=5
      X=ANGLE
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(X,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM CASE                              **
C               ******************************************************
C
 3300 CONTINUE
      IF(IDIR.EQ.'VERT')GOTO3310
      ICSTR(1:15)='TEXTPATH RIGHT;'
      NCSTR=15
      GOTO3390
 3310 CONTINUE
      IF(IJUSSW.EQ.'ON')GOTO 3320
      ICSTR(1:15)='TEXTPATH RIGHT;'
      NCSTR=15
      GOTO3390
 3320 CONTINUE
      ICSTR(1:14)='TEXTPATH DOWN;'
      NCSTR=14
      GOTO3390
 3390 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE                             **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE                          **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
C               *************************************************
C
10000 CONTINUE
      CALL TCSEDI(IDIR)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEDI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDIR,ANGLE
 9013 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)JDIR,ANGLE2
 9014 FORMAT('JDIR,ANGLE2 = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IMANUF,IMODEL
 9015 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IGUNIT
 9016 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ANGLE,X,NCHTOT,NCHDEC
 9017 FORMAT('ANGLE,X,NCHTOT,NCHDEC = ',2E15.7,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEFI(ICASE,IFILLT,JFILLT)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A FILL SPECIFICATION (ON/OFF)
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IFILLT
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEFI'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEFI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFILLT
   53 FORMAT('IFILLT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4662')GOTO1100
C
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4662                        **
C               **  (A PENPLOTTER).                                 **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 12--                                               **
C               **  TREAT THE TEKTRONIX 4027 CASE                           **
C               **  (COLOR RASTER DEVICES).                                 **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1200 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO1210
      IF(ICASE.EQ.'REGI')GOTO1210
      IF(ICASE.EQ.'MARK')GOTO1210
      IF(ICASE.EQ.'TEXT')GOTO1220
      GOTO1210
C
 1210 CONTINUE
      GOTO9000
C
 1220 CONTINUE
CCCCC WRITE(IGUNIT,1221)JFILLT
C1221 FORMAT('!ATT C',I1,';')
      ICSTR(1:6)='!ATT C'
      IX=JFILLT+48
CCCCC ICSTR(7:7)=CHAR(IX)
      CALL DPCONA(IX,ICSTR(7:7))
      ICSTR(8:8)=';'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE TEKTRONIX 4105                        **
C               **  (COLOR RASTER DEVICE).                          **
C               **  REFERENCE--PAGE XXXX (LINE), XXXX (TEXT),       **
C               **             XXXX (REGION)                        **
C               ******************************************************
C
 1300 CONTINUE
C     ????????
      GOTO9000
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 73.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-10, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
C     ???????
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      ICSTR(1:9)='SET FILL '
      ICSTR(10:13)=IFILLT
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:5)='SEFI '
      ICSTR(6:9)=IFILLT
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM CASE                              **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRSEFI TO SET FILL  CALCOMP DEVICE')
CCCCC ICSTR(1:49)='FIX SUBROUTINE GRSEFI TO SET FILL  CALCOMP DEVICE'
CCCCC NCSTR=49
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRSEFI TO SET FILL  RAMTEK DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRSEFI TO SET FILL  RAMTEK DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET FILL--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRSEFI TO SET FILL  XXXXXX DEVICE')
      ICSTR(1:48)='FIX SUBROUTINE GRSEFI TO SET FILL  XXXXXX DEVICE'
      NCSTR=48
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE                             **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE                          **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      CALL TCSEFI(IFILLT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEFI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFILLT,JFILLT
 9013 FORMAT('IFILLT,JFILLT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IX
 9020 FORMAT('IX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEFO(ICASE,IFONT,JFONT)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A FONT
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IFONT
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEFO'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEFO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFONT
   53 FORMAT('IFONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **********************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)IFONT
C3111 FORMAT('SET FONT ',A4)
C  CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
C  "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
C  DRAW COMMANDS)
C  "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
C  TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
C  STRING
C
C  "NULL" TELLS THE POST-PROCESSOR THAT DATAPLOT WILL DRAW THE STRING
C  AS LOW LEVEL MOVE AND DRAW COMMANDS.
C
      ICSTR(1:9)='SET FONT '
      ICSTR(10:13)=IFONT
      IF(IFNTSW.EQ.'OFF'.AND.IFONT.NE.'TEKT')ICSTR(10:13)='NULL'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
C  CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
C  "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
C  DRAW COMMANDS)
C  "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
C  TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
C  STRING
C
C  "NULL" TELLS THE POST-PROCESSOR THAT DATAPLOT WILL DRAW THE STRING
C  AS LOW LEVEL MOVE AND DRAW COMMANDS.
C
      ICSTR(1:5)='SEFO '
      ICSTR(6:9)=IFONT
      IF(IFNTSW.EQ.'OFF'.AND.IFONT.NE.'TEKT')ICSTR(10:13)='NULL'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM                                CASE        **
C               ***************************************************************
C
 3300 CONTINUE
C  CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
C  "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
C  DRAW COMMANDS), SO METAFILE SHOULD NOT SET TEXT FONT
C  "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
C  TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
C  STRING
C
      IF(IFNTSW.EQ.'OFF')GOTO3390
      ICSTR(1:14)='TEXTFONTINDEX '
      NCSTR=14
      NCHTOT=2
      CALL GRTRIN(JFONT,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3390 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
C               *************************************************
C
10000 CONTINUE
      CALL TCSEFO(IFONT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
CAQUA CALL aqtSetFontname(IAQUFN)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEFO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFONT,JFONT
 9013 FORMAT('IFONT,JFONT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEJU(ICASE,IJUST,JJUST)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A JUSTIFICATION
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. LATEK
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEJU'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEJU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IJUST
   53 FORMAT('IJUST = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)IJUST
C3111 FORMAT('SET JUSTIFICATION ',A4)
      ICSTR(1:18)='SET JUSTIFICATION '
      ICSTR(19:22)=IJUST
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:5)='SEJU '
      ICSTR(6:9)=IJUST
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE GENERAL CGM CASE                      **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 3300 CONTINUE
C
      IF(IJUSSW.EQ.'OFF')GOTO9000
C
      IF(IJUST.EQ.'LEFT')GOTO3310
      IF(IJUST.EQ.'CENT')GOTO3320
      IF(IJUST.EQ.'RIGH')GOTO3330
C
      IF(IJUST.EQ.'LJUS')GOTO3310
      IF(IJUST.EQ.'CJUS')GOTO3320
      IF(IJUST.EQ.'RJUS')GOTO3330
C
      IF(IJUST.EQ.'LEBO')GOTO3310
      IF(IJUST.EQ.'CEBO')GOTO3320
      IF(IJUST.EQ.'RIBO')GOTO3330
C
      IF(IJUST.EQ.'LECE')GOTO3340
      IF(IJUST.EQ.'CECE')GOTO3350
      IF(IJUST.EQ.'RICE')GOTO3360
C
      IF(IJUST.EQ.'LETO')GOTO3370
      IF(IJUST.EQ.'CETO')GOTO3380
      IF(IJUST.EQ.'RITO')GOTO3390
C
      GOTO3310
C
 3310 CONTINUE
      ICSTR(1:26)='TEXTALIGN LEFT,BOTTOM,0,0;'
      NCSTR=26
      GOTO3399
C
 3320 CONTINUE
      ICSTR(1:25)='TEXTALIGN CTR,BOTTOM,0,0;'
      NCSTR=25
      GOTO3399
C
 3330 CONTINUE
      ICSTR(1:27)='TEXTALIGN RIGHT,BOTTOM,0,0;'
      NCSTR=27
      GOTO3399
C
 3340 CONTINUE
      ICSTR(1:24)='TEXTALIGN LEFT,HALF,0,0;'
      NCSTR=24
      GOTO3399
C
 3350 CONTINUE
      ICSTR(1:23)='TEXTALIGN CTR,HALF,0,0;'
      NCSTR=23
      GOTO3399
C
 3360 CONTINUE
      ICSTR(1:25)='TEXTALIGN RIGHT,HALF,0,0;'
      NCSTR=25
      GOTO3399
C
 3370 CONTINUE
      ICSTR(1:23)='TEXTALIGN LEFT,TOP,0,0;'
      NCSTR=23
      GOTO3399
C
 3380 CONTINUE
      ICSTR(1:22)='TEXTALIGN CTR,TOP,0,0;'
      NCSTR=22
      GOTO3399
C
 3390 CONTINUE
      ICSTR(1:24)='TEXTALIGN RIGHT,TOP,0,0;'
      NCSTR=24
      GOTO3399
C
 3399 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  DONE VIA settextjustify in GRWRTH & GRWRTV **
C               *************************************************
C
10000 CONTINUE
      CALL TCSEJU(IJUST)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEJU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IJUST,JJUST
 9013 FORMAT('IJUST,JJUST = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEMO(IGRASW,PDIAXC,PDIAYC)
C
C     PURPOSE--SET TERMINAL INTO GRAPHICS MODE
C              OR TO DIAGLOGUE MODE
C              ON A SPECIFIC GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IGRASW
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
CCCCC THE FOLLOWING LINE WAS INSERTED   MAY 1991   JJF
      CHARACTER*4 IC4
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEMO'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEMO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IGRASW
   56 FORMAT('IGRASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)PDIAXC,PDIAYC
   57 FORMAT('PDIAXC,PDIAYC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'AQUA')GOTO1091
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4020')GOTO1100
      IF(IMODEL.EQ.'4022')GOTO1100
      IF(IMODEL.EQ.'4025')GOTO1100
      IF(IMODEL.EQ.'4027')GOTO1100
C
      IF(IMODEL.EQ.'4105')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4109')GOTO1200
      IF(IMODEL.EQ.'4115')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4113')GOTO1200
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1091 CONTINUE
      GOTO13500
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE 4027 CASE--                           **
C               **  (A COLOR TERMINAL).                             **
C               **  EXCLAMATION POINT MON K  (PAGE XXX)             **
C               ******************************************************
C
C     CORRECTIONS PROVIDED BY MARIA ZIMMER
C     WRIGHT-PATTERSON AFB, OHIO   JANUARY 1985
C
 1100 CONTINUE
      IF(IGRASW.EQ.'ON')GOTO1190
CCCCC ICSTR(1:8)='!MON H K'
CCCCC NCSTR=8
      ICSTR(1:6)='!MON K'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE TEKTRONIX 4105 CASE                   **
C               **  (A COLOR DEVICE)                                **
C               **  1. ENABLE DIALOGUE AREA                         **
C               **     ESCAPE KA1   (PAGE 5-14)                     **
C               **  2. ERASE DIAGLOUE AREA (AND BUFFER)             **
C               **     ESCAPE LZ     (PAGE 5-8)                     **
C               **     THIS IS A PATCH SO THAT AFTER A PLOT IS FORME**
C               **     THE DIALGOU WILL NOT IMMEDIATELY APPEAR ATOP **
C               **     BETTER SOLUTION IS TO PLACE DIALOGUE CURSOR A**
C               **     TOP OF SCREEN BUT PROBABLY CANNOT DO IT      **
C               **     ON 4105                                      **
C               **     NET EFFECT IS THAT WHENEVER DIALOGUEMODE IS  **
C               **     ENTERED, THE DIAGOGUE BUFFER WILL BE ERASED. **
C               **  3. MAKE DIALOGUE AREA VISIBLE                   **
C               **     ESCAPE LV1      (PAGE 5-39)                  **
C               ** 11. DISABLE DIALOGUE AREA                        **
C               **     ESCAPE KA0   (PAGE 5-14)                     **
C               ** 12. MAKE DIALOGUE AREA INVISIBLE                 **
C               **     ESCAPE LV0      (PAGE 5-39)                  **
C               ******************************************************
C
 1200 CONTINUE
      IF(IGRASW.EQ.'OFF')GOTO1210
      GOTO1220
C
 1210 CONTINUE
CCCCC WRITE(IGUNIT,1211)IESCC
C1211 FORMAT(A1,'KA1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='KA1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C     THE FOLLOWING 3-LINE 4105 ETC. PATCH WAS ENTERED AUGUST 25, 1986
      ICSTR(1:1)=IUSC
      NCSTR=1
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1212)IESCC
C1212 FORMAT(A1,'LZ')
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='LZ'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1213)IESCC
C1213 FORMAT(A1,'LV1')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='LV1'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO1290
C
 1220 CONTINUE
CCCCC WRITE(IGUNIT,1221)IESCC
C1221 FORMAT(A1,'KA0')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='KA0'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC WRITE(IGUNIT,1222)IESCC
C1222 FORMAT(A1,'LV0')
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='LV0'
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO1290
C
 1290 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-4, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      IF(IGRASW.EQ.'OFF')GOTO2310
      GOTO2320
C
 2310 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='*deZ'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO2390
C
 2320 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:5)='*dcZ'
      NCSTR=5
      GOTO2390
C
 2390 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD LASER JET CASES           **
C               **  LANDSCAPE ORIENTATION                               **
C               **  OFFLINE DEVICE, NULL ROUTINE                        **
C               **     STEP 1--                                         **
C               **  REFERENCE--                                         **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **********************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC IF(IGRASW.EQ.'OFF')WRITE(IGUNIT,3111)
C3111 FORMAT('ENTER DIALOGUE MODE')
CCCCC IF(IGRASW.EQ.'ON')WRITE(IGUNIT,3112)
C3112 FORMAT('ENTER GRAPHICS MODE')
      IF(IGRASW.EQ.'OFF')GOTO3110
      GOTO3120
 3110 CONTINUE
      ICSTR(1:19)='ENTER DIALOGUE MODE'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
 3120 CONTINUE
      ICSTR(1:19)='ENTER GRAPHICS MODE'
      NCSTR=19
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      IF(IGRASW.EQ.'OFF')GOTO3210
      GOTO3220
 3210 CONTINUE
      ICSTR(1:5)='SEMO '
      ICSTR(6:9)='DIAL'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
 3220 CONTINUE
      ICSTR(1:5)='SEMO '
      ICSTR(6:9)='GRAP'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
C               ***************************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET MODE--                                   **
C               **  OFFLINE DEVICE, NULL ROUTINE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRSEMO TO SET MODE ON CALCOMP DEVICE')
CCCCC ICSTR(1:51)='FIX SUBROUTINE GRSEMO TO SET MODE ON CALCOMP DEVICE'
CCCCC NCSTR=51
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET MODE--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRSEMO TO SET MODE ON RAMTEK DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSEMO TO SET MODE ON RAMTEK DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - NULL ROUTINE               **
C               ******************************************************
C
 6600 CONTINUE
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET MODE--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRSEMO TO SET MODE ON XXXXXX DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSEMO TO SET MODE ON XXXXXX DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO GO INTO ALPHA    MODE---                     **
C               **  WRITE OUT AN ESC BACKSLASH                      **
C               **  TO GO INTO GRAPHICS MODE---                     **
C               **  WRITE OUT AN ESC P p                            **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 96                             **
C               ******************************************************
C
 8100 CONTINUE
      IF(IGRASW.EQ.'OFF')GOTO8210
      GOTO8220
C
 8210 CONTINUE
      ICSTR(1:1)=IESCC
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      ICSTR(2:2)=IBASLC
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8290
C
 8220 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='Pp'
      NCSTR=3
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO8290
C
 8290 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 95--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      IC4='DIAL'
      IF(IGRASW.EQ.'ON')IC4='GRAP'
      CALL TCSEMO(IC4)
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEMO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEMO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IGRASW
 9016 FORMAT('IGRASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PDIAXC,PDIAYC
 9017 FORMAT('PDIAXC,PDIAYC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEPA(ICASE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A PATTERN
C              ON A SPECIFIC GRAPHICS DEVICE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. ISUBNO TO ISUBN0 (JJF)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. BLANK PATTERN (JPATTT=-1) ON
C                                      SOME DEVICES
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC ADD FOLLOWING LINE FOR MICROSOFT COMPILER OCTOBER 1996
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF INTEGER(2) STYLE
C
      CHARACTER*4 ICASE
      CHARACTER*4 IPATTT
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*1 IPATTZ
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
      DIMENSION ARRCAL(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XLATTR
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SEPA'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSEPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IPATTT,JPATTT
   53 FORMAT('IPATTT,JPATTT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PXSPA,PYSPA,PXSPA2,PYSPA2
   54 FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IHORPA,IVERPA,IDUPPA,IDDOPA
   55 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)IMANUF,IMODEL
   58 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4006')GOTO1400
      IF(IMODEL.EQ.'4010')GOTO1400
C
      IF(IMODEL.EQ.'4020')GOTO1200
      IF(IMODEL.EQ.'4022')GOTO1200
      IF(IMODEL.EQ.'4025')GOTO1200
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ********************************
C               **  STEP 11--                 **
C               **  TREAT THE TEKTRONIX 4014  **
C               **  REFERENCE--40Z105 MANUAL, PAGE 5-52  **
C               ********************************
C
 1100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO1110
      IF(ICASE.EQ.'REGI')GOTO1120
      IF(ICASE.EQ.'MARK')GOTO1130
      IF(ICASE.EQ.'TEXT')GOTO1140
      GOTO1110
C
 1110 CONTINUE
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
CCCCC IPATTZ=CHAR(JPATTT)
      CALL DPCONA(JPATTT,IPATTZ)
CCCCC WRITE(IGUNIT,1111)IESCC,IPATTZ
C1111 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IPATTZ
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1120 CONTINUE
      GOTO9000
C
 1130 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 12--                                               **
C               **  TREAT THE TEKTRONIX 4027                                **
C               **  (COLOR RASTER DEVICE).                                  **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1200 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO1210
      IF(ICASE.EQ.'REGI')GOTO1220
      IF(ICASE.EQ.'MARK')GOTO1230
      IF(ICASE.EQ.'TEXT')GOTO1240
      GOTO1220
C
 1210 CONTINUE
CCCCC WRITE(IGUNIT,1211)JPATTT
C1211 FORMAT('!LIN ',I8)
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      ICSTR(1:5)='!LIN '
      NCSTR=5
      NCHTOT=8
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1220 CONTINUE
      GOTO9000
C
 1230 CONTINUE
      GOTO9000
C
 1240 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 13--                                               **
C               **  TREAT THE TEKTRONIX 4105                                **
C               **  (COLOR RASTER DEVICE).                                  **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1300 CONTINUE
C
      IF(ICASE.EQ.'LINE')GOTO1310
      IF(ICASE.EQ.'REGI')GOTO1320
      IF(ICASE.EQ.'MARK')GOTO1330
      IF(ICASE.EQ.'TEXT')GOTO1340
      GOTO1310
C
 1310 CONTINUE
CCCCC IPATTZ=CHAR(JPATTT)
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      CALL DPCONA(JPATTT,IPATTZ)
CCCCC WRITE(IGUNIT,1311)IESCC,IPATTZ
C1311 FORMAT(A1,A1)
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=IPATTZ
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 1320 CONTINUE
      GOTO9000
C
 1330 CONTINUE
      GOTO9000
C
 1340 CONTINUE
      GOTO9000
C
C               **************************************************************
C               **  STEP 14--                                               **
C               **  TREAT THE TEKTRONIX 4010 AND 4006
C               **  (THEY HAVE ONLY SOLID LINES AND INCOMPLETE PLOT-10      **
C               **  REFERENCE--XXX                                          **
C               **************************************************************
C
 1400 CONTINUE
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      GOTO9000
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE 258 AND 152.                  **
C               ****************************************************
C
 2100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2110
      IF(ICASE.EQ.'REGI')GOTO2120
      IF(ICASE.EQ.'MARK')GOTO2130
      IF(ICASE.EQ.'TEXT')GOTO2140
      GOTO2110
C
 2110 CONTINUE
CCCCC IF(IPATTT.EQ.'BLAN')WRITE(IGUNIT,2111)
CCCCC IF(IPATTT.EQ.'BL  ')WRITE(IGUNIT,2111)
CCCCC IF(IPATTT.EQ.'NONE')WRITE(IGUNIT,2111)
CCCCC IF(IPATTT.EQ.'NO  ')WRITE(IGUNIT,2111)
CCCCC IF(IPATTT.EQ.'    ')WRITE(IGUNIT,2111)
C2111 FORMAT('~Q @ @cH}')
CCCCC IF(IPATTT.EQ.'SOLI')WRITE(IGUNIT,2112)
CCCCC IF(IPATTT.EQ.'SO  ')WRITE(IGUNIT,2112)
C2112 FORMAT('~Q}')
CCCCC IF(IPATTT.EQ.'DOTT')WRITE(IGUNIT,2113)
CCCCC IF(IPATTT.EQ.'DOT ')WRITE(IGUNIT,2113)
CCCCC IF(IPATTT.EQ.'DO  ')WRITE(IGUNIT,2113)
C2113 FORMAT('~Q!A!A!A!Aa@}')
CCCCC IF(IPATTT.EQ.'DASH')WRITE(IGUNIT,2114)
CCCCC IF(IPATTT.EQ.'DA  ')WRITE(IGUNIT,2114)
C2114 FORMAT('~Q"A"Aa@}')
CCCCC IF(IPATTT.EQ.'DA1 ')WRITE(IGUNIT,2115)
C2115 FORMAT('~Q$Ba@}')
CCCCC IF(IPATTT.EQ.'DA2 ')WRITE(IGUNIT,2116)
C2116 FORMAT('~Q#A!Aa@}')
      IF(IPATTT.EQ.'BLAN')GOTO2111
      IF(IPATTT.EQ.'BL  ')GOTO2111
      IF(IPATTT.EQ.'NONE')GOTO2111
      IF(IPATTT.EQ.'NO  ')GOTO2111
      IF(IPATTT.EQ.'    ')GOTO2111
      IF(IPATTT.EQ.'SOLI')GOTO2112
      IF(IPATTT.EQ.'SO  ')GOTO2112
      IF(IPATTT.EQ.'DOTT')GOTO2113
      IF(IPATTT.EQ.'DOT ')GOTO2113
      IF(IPATTT.EQ.'DO  ')GOTO2113
      IF(IPATTT.EQ.'DASH')GOTO2114
      IF(IPATTT.EQ.'DA  ')GOTO2114
      IF(IPATTT.EQ.'DA1 ')GOTO2115
      IF(IPATTT.EQ.'DA2 ')GOTO2116
      IF(IPATTT.EQ.'DA3 ')GOTO2117
      IF(IPATTT.EQ.'DA4 ')GOTO2118
      GOTO2112
 2111 CONTINUE
      ICSTR(1:9)='~Q @ @cH}'
      NCSTR=9
      GOTO2119
 2112 CONTINUE
      ICSTR(1:3)='~Q}'
      NCSTR=3
      GOTO2119
 2113 CONTINUE
      ICSTR(1:13)='~Q!A!A!A!Aa@}'
      NCSTR=13
      GOTO2119
 2114 CONTINUE
      ICSTR(1:9)='~Q"A"Aa@}'
      NCSTR=9
      GOTO2119
 2115 CONTINUE
      ICSTR(1:7)='~Q$Ba@}'
      NCSTR=7
      GOTO2119
 2116 CONTINUE
      ICSTR(1:9)='~Q#A!Aa@}'
      NCSTR=9
      GOTO2119
 2117 CONTINUE
      ICSTR(1:9)='~Q#A!Aa@}'
      NCSTR=9
      GOTO2119
 2118 CONTINUE
      ICSTR(1:9)='~Q#A!Aa@}'
      NCSTR=9
      GOTO2119
 2119 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 2120 CONTINUE
      GOTO9000
C
 2130 CONTINUE
      GOTO9000
C
 2140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO SET PATTERN--                                **
C               **  WRITE OUT A    LT     PATTERN NUMBER            **
C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 100, 141.                       **
C               ******************************************************
C
 2200 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2210
      IF(ICASE.EQ.'REGI')GOTO2220
      IF(ICASE.EQ.'MARK')GOTO2230
      IF(ICASE.EQ.'TEXT')GOTO2240
      GOTO2210
C
 2210 CONTINUE
      ICSTR(1:2)='LT'
      IF(JPATTT.GE.0)GOTO2215
      ICSTR(3:3)=';'
      NCSTR=3
      GOTO2219
C
 2215 CONTINUE
      NCSTR=2
      NCHTOT=1
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      ICSTR(4:4)=';'
      NCSTR=4
C
 2219 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED    MAY 1991
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBNO)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 2220 CONTINUE
      GOTO9000
C
 2230 CONTINUE
      GOTO9000
C
 2240 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-6, 10-7.                         **
C               **********************************************************
C
 2300 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2310
      IF(ICASE.EQ.'REGI')GOTO2320
      IF(ICASE.EQ.'MARK')GOTO2330
      IF(ICASE.EQ.'TEXT')GOTO2340
      GOTO2310
C
 2310 CONTINUE
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*m'
      NCSTR=3
      NCHTOT=1
      IF(JPATTT.GT.9)NCHTOT=2
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      NCSTRT=NCSTR+1
      NCEND=NCSTR+2
      ICSTR(NCSTRT:NCEND)='bZ'
      NCSTR=NCEND
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 2320 CONTINUE
      GOTO9000
C
 2330 CONTINUE
      GOTO9000
C
 2340 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **  LASERJET SERIES II LASER PRINTERS                   **
C               **********************************************************
C
 2600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2610
      IF(ICASE.EQ.'REGI')GOTO2620
      IF(ICASE.EQ.'MARK')GOTO2630
      IF(ICASE.EQ.'TEXT')GOTO2640
      GOTO2610
C
 2610 CONTINUE
      GOTO9000
C
 2620 CONTINUE
      GOTO9000
C
 2630 CONTINUE
      GOTO9000
C
 2640 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
CCCCC IF(ICASE.EQ.'LINE')WRITE(IGUNIT,3111)IPATTT
C3111 FORMAT('SET PATTERN LINE ',A4)
CCCCC IF(ICASE.EQ.'REGI')WRITE(IGUNIT,3112)IPATTT
C3112 FORMAT('SET PATTERN REGION ',A4)
CCCCC IF(ICASE.EQ.'MARK')WRITE(IGUNIT,3113)IPATTT
C3113 FORMAT('SET PATTERN MARKER ',A4)
CCCCC IF(ICASE.EQ.'TEXT')WRITE(IGUNIT,3114)IPATTT
C3114 FORMAT('SET PATTERN TEXT ',A4)
      IF(ICASE.EQ.'LINE')GOTO3111
      IF(ICASE.EQ.'REGI')GOTO3112
      IF(ICASE.EQ.'MARK')GOTO3113
      IF(ICASE.EQ.'TEXT')GOTO3114
      GOTO3119
 3111 CONTINUE
      ICSTR(1:17)='SET PATTERN LINE '
      ICSTR(18:21)=IPATTT
      NCSTR=21
      GOTO3118
 3112 CONTINUE
      ICSTR(1:19)='SET PATTERN REGION '
      ICSTR(20:24)=IPATTT
      NCSTR=24
      GOTO3118
 3113 CONTINUE
      ICSTR(1:19)='SET PATTERN MARKER '
      ICSTR(20:24)=IPATTT
      NCSTR=24
      GOTO3118
 3114 CONTINUE
      ICSTR(1:17)='SET PATTERN TEXT '
      ICSTR(18:21)=IPATTT
      NCSTR=21
      GOTO3118
 3118 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
 3119 CONTINUE
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO3211
      IF(ICASE.EQ.'REGI')GOTO3212
      IF(ICASE.EQ.'MARK')GOTO3213
      IF(ICASE.EQ.'TEXT')GOTO3214
      GOTO3219
 3211 CONTINUE
      ICSTR(1:10)='SEPA LINE '
      ICSTR(11:14)=IPATTT
      NCSTR=14
      GOTO3218
 3212 CONTINUE
      ICSTR(1:10)='SEPA REGI '
      ICSTR(11:14)=IPATTT
      NCSTR=14
      GOTO3218
 3213 CONTINUE
      ICSTR(1:10)='SEPA MARK '
      ICSTR(11:14)=IPATTT
      NCSTR=14
      GOTO3218
 3214 CONTINUE
      ICSTR(1:10)='SEPA TEXT '
      ICSTR(11:14)=IPATTT
      NCSTR=14
      GOTO3218
 3218 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
 3219 CONTINUE
C
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM                                CASE        **
C               ***************************************************************
C
 3300 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO3311
      IF(ICASE.EQ.'REGI')GOTO3312
      IF(ICASE.EQ.'MARK')GOTO3313
      IF(ICASE.EQ.'TEXT')GOTO3314
      GOTO3319
 3311 CONTINUE
      ICSTR(1:9)='LINETYPE '
      NCHTOT=1
      NCSTR=9
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=';'
      NCSTR=11
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3318
 3312 CONTINUE
      IF(IPATTT.EQ.'SOLI')GOTO3322
      IF(IPATTT.EQ.'FILL')GOTO3322
      ICSTR(1:15)='INTSTYLE HATCH;'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='HATCHINDEX '
      NCHTOT=1
      NCSTR=11
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      ICSTR(13:13)=';'
      NCSTR=13
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3318
 3322 CONTINUE
      ICSTR(1:15)='INTSTYLE SOLID;'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3318
 3313 CONTINUE
      GOTO3318
 3314 CONTINUE
      GOTO3318
 3318 CONTINUE
      GOTO9000
 3319 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET PATTERN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--CALCOMP ELECTROMECHANICAL PLOTTERS - **
C               **             PROGRAMMING, CALCOMP, 1987           **
C               **             PAGES 33 AND 34                      **
C               **  USE CALCOMP LIBRARY ROUTINE DASHS               **
C               **  SINCE THIS ROUTINE IS NOT SUPPORTED BY MANY     **
C               **  VERSIONS OF THE LIBRARY, COMMENT OUT.  SITES    **
C               **  CAN ACTIVATE IF DESIRED.                        **
C               **      CALL DASHS(ARRAY,ICNT)                      **
C               **  WHERE                                           **
C               **      ICNT=0   - TURN ON SOLID LINE               **
C               **      ICNT=2, ARRAY(1)=0.1, (2)=-0.1 - DEFAULT    **
C               **                 DASH PATTERN.                    **
C               **  ARRAY GIVES LENGTH OF ALTERNATING SOLID AND     **
C               **  SEGMENTS IN INCHES.  CURRENTLY ONLY DEFINE 1    **
C               **  DASH AND 1 DOTTED PATTERN                       **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRSEPA TO SET PATTERN CALCOMP DEVICE')
CCCCC ICSTR(1:51)='FIX SUBROUTINE GRSEPA TO SET PATTERN CALCOMP DEVICE'
CCCCC NCSTR=51
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICASE.EQ.'LINE')GOTO4110
      IF(ICASE.EQ.'REGI')GOTO4120
      IF(ICASE.EQ.'MARK')GOTO4130
      IF(ICASE.EQ.'TEXT')GOTO4140
      GOTO4110
C
 4110 CONTINUE
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      IF(JPATTT.EQ.2)GOTO4112
      IF(JPATTT.EQ.1)GOTO4114
      IF(JPATTT.GT.2)GOTO4114
C
      ARRCAL(1)=0.
      ARRCAL(2)=0.
      ICNT=0
      GOTO4119
C
 4112 CONTINUE
      ICNT=2
      ARRCAL(1)=0.05
      ARRCAL(2)=-0.05
      GOTO4119
C
 4114 CONTINUE
      ICNT=2
      ARRCAL(1)=0.1
      ARRCAL(2)=-0.1
      GOTO4119
C
 4119 CONTINUE
C
C     FOLLOWING LINE TO ACTIVATE CALCOMP DASHED LINES
C
      CALL DASHS(ARRCAL,ICNT)
      GOTO9000
C
 4120 CONTINUE
      GOTO9000
C
 4130 CONTINUE
      GOTO9000
C
 4140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4610
      IF(ICASE.EQ.'REGI')GOTO4620
      IF(ICASE.EQ.'MARK')GOTO4630
      IF(ICASE.EQ.'TEXT')GOTO4640
      GOTO4610
C
 4610 CONTINUE
      GOTO9000
C
 4620 CONTINUE
      GOTO9000
C
 4630 CONTINUE
      GOTO9000
C
 4640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4710
      IF(ICASE.EQ.'REGI')GOTO4720
      IF(ICASE.EQ.'MARK')GOTO4730
      IF(ICASE.EQ.'TEXT')GOTO4740
      GOTO4710
C
 4710 CONTINUE
CQWVF IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
CQWVF1   IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
CQWVF1   IPATTT.EQ.'    ')THEN
CQWVF    STYLE=#0000
CQWVF ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
CQWVF    STYLE=#FFFF
CQWVF ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
CQWVF1   IPATTT.EQ.'DO  ')THEN
CQWVF    STYLE=#AAAA
CQWVF ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
CQWVF    STYLE=#FF00
CQWVF ELSEIF(IPATTT.EQ.'DA1 ')THEN
CQWVF    STYLE=#FF00
CQWVF ELSEIF(IPATTT.EQ.'DA2 ')THEN
CQWVF    STYLE=#F0F0
CQWVF ELSEIF(IPATTT.EQ.'DA3 ')THEN
CQWVF    STYLE=#3C3C
CQWVF ELSEIF(IPATTT.EQ.'DA4 ')THEN
CQWVF    STYLE=#8888
CQWVF ELSE
CQWVF    STYLE=#FFFF
CQWVF ENDIF
CQWVF CALL SETLINESTYLE(STYLE)
      GOTO9000
C
 4720 CONTINUE
      GOTO9000
C
 4730 CONTINUE
      GOTO9000
C
 4740 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4810
      IF(ICASE.EQ.'REGI')GOTO4820
      IF(ICASE.EQ.'MARK')GOTO4830
      IF(ICASE.EQ.'TEXT')GOTO4840
      GOTO4810
C
 4810 CONTINUE
      IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
     1   IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
     1   IPATTT.EQ.'    ')THEN
      ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
      ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
     1   IPATTT.EQ.'DO  ')THEN
      ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
      ELSEIF(IPATTT.EQ.'DA1 ')THEN
      ELSEIF(IPATTT.EQ.'DA2 ')THEN
      ELSEIF(IPATTT.EQ.'DA3 ')THEN
      ELSEIF(IPATTT.EQ.'DA4 ')THEN
      ELSE
      ENDIF
      GOTO9000
C
 4820 CONTINUE
      GOTO9000
C
 4830 CONTINUE
      GOTO9000
C
 4840 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4910
      IF(ICASE.EQ.'REGI')GOTO4920
      IF(ICASE.EQ.'MARK')GOTO4930
      IF(ICASE.EQ.'TEXT')GOTO4940
      GOTO4910
C
 4910 CONTINUE
      IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
     1   IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
     1   IPATTT.EQ.'    ')THEN
CINTE   CALL IGrLineType(0)
      ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
CINTE   CALL IGrLineType(0)
      ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
     1   IPATTT.EQ.'DO  ')THEN
CINTE   CALL IGrLineType(1)
      ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
CINTE   CALL IGrLineType(2)
      ELSEIF(IPATTT.EQ.'DA1 ')THEN
CINTE   CALL IGrLineType(3)
      ELSEIF(IPATTT.EQ.'DA2 ')THEN
CINTE   CALL IGrLineType(4)
      ELSEIF(IPATTT.EQ.'DA3 ')THEN
CINTE   CALL IGrLineType(5)
      ELSEIF(IPATTT.EQ.'DA4 ')THEN
CINTE   CALL IGrLineType(6)
      ELSE
      ENDIF
      GOTO9000
C
 4920 CONTINUE
      GOTO9000
C
 4930 CONTINUE
      GOTO9000
C
 4940 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4960
      IF(ICASE.EQ.'REGI')GOTO4970
      IF(ICASE.EQ.'MARK')GOTO4980
      IF(ICASE.EQ.'TEXT')GOTO4990
      GOTO4810
C
 4960 CONTINUE
      IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
     1   IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
     1   IPATTT.EQ.'    ')THEN
CWINT   CALL IGrLineType(0)
      ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
CWINT   CALL IGrLineType(0)
      ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
     1   IPATTT.EQ.'DO  ')THEN
CWINT   CALL IGrLineType(1)
      ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
CWINT   CALL IGrLineType(2)
      ELSEIF(IPATTT.EQ.'DA1 ')THEN
CWINT   CALL IGrLineType(3)
      ELSEIF(IPATTT.EQ.'DA2 ')THEN
CWINT   CALL IGrLineType(4)
      ELSEIF(IPATTT.EQ.'DA3 ')THEN
CWINT   CALL IGrLineType(5)
      ELSEIF(IPATTT.EQ.'DA4 ')THEN
CWINT   CALL IGrLineType(6)
      ELSE
      ENDIF
      GOTO9000
C
 4970 CONTINUE
      GOTO9000
C
 4980 CONTINUE
      GOTO9000
C
 4990 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO SET PATTERN--                                **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE ZETA VERSION OF CALCOMP LIBRARY.  VALUE OF  **
C               **  LINE PATTERN STORED IN DEVICE COMMON.  USED IN  **
C               **  VALUE OF "IPEN" SENT TO PLOT ROUTINE.  NOTHING  **
C               **  DONE IN THIS ROUTINE                            **
C               ******************************************************
C
 5100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO5110
      IF(ICASE.EQ.'REGI')GOTO5120
      IF(ICASE.EQ.'MARK')GOTO5130
      IF(ICASE.EQ.'TEXT')GOTO5140
      GOTO5110
C
 5110 CONTINUE
      GOTO9000
C
 5120 CONTINUE
      GOTO9000
C
 5130 CONTINUE
      GOTO9000
C
 5140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET PATTERN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRSEPA TO SET PATTERN RAMTEK DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSEPA TO SET PATTERN RAMTEK DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICASE.EQ.'LINE')GOTO6110
      IF(ICASE.EQ.'REGI')GOTO6120
      IF(ICASE.EQ.'MARK')GOTO6130
      IF(ICASE.EQ.'TEXT')GOTO6140
      GOTO6110
C
 6110 CONTINUE
      GOTO9000
C
 6120 CONTINUE
      GOTO9000
C
 6130 CONTINUE
      GOTO9000
C
 6140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
 6600 CONTINUE
CCCCC IF(JPATTT.LT.0)CALL cflntype(0)
CCCCC IF(JPATTT.GE.0)CALL cflntype(JPATTT)
      IF(ICASE.EQ.'LINE')GOTO6610
      IF(ICASE.EQ.'REGI')GOTO6610
      IF(ICASE.EQ.'MARK')GOTO6610
      IF(ICASE.EQ.'TEXT')GOTO6620
 6610 CONTINUE
      IF(IPATTT.EQ.'BLAN')GOTO9000
      IF(IPATTT.EQ.'BL  ')GOTO9000
      IF(IPATTT.EQ.'NONE')GOTO9000
      IF(IPATTT.EQ.'NO  ')GOTO9000
      IF(IPATTT.EQ.'    ')GOTO9000
CSUN  IF(IPATTT.EQ.'SOLI')CALL cflntype(0)
CSUN  IF(IPATTT.EQ.'SO  ')CALL cflntype(0)
CSUN  IF(IPATTT.EQ.'DOTT')CALL cflntype(1)
CSUN  IF(IPATTT.EQ.'DOT ')CALL cflntype(1)
CSUN  IF(IPATTT.EQ.'DO  ')CALL cflntype(1)
CSUN  IF(IPATTT.EQ.'DASH')CALL cflntype(2)
CSUN  IF(IPATTT.EQ.'DA  ')CALL cflntype(2)
CSUN  IF(IPATTT.EQ.'DA1 ')CALL cflntype(3)
CSUN  IF(IPATTT.EQ.'DA2 ')CALL cflntype(4)
CSUN  IF(IPATTT.EQ.'DA3 ')CALL cflntype(5)
 6620 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET PATTERN--                                **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRSEPA TO SET PATTERN XXXXXX DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSEPA TO SET PATTERN XXXXXX DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(ICASE.EQ.'LINE')GOTO7110
      IF(ICASE.EQ.'REGI')GOTO7120
      IF(ICASE.EQ.'MARK')GOTO7130
      IF(ICASE.EQ.'TEXT')GOTO7140
      GOTO7110
C
 7110 CONTINUE
      GOTO9000
C
 7120 CONTINUE
      GOTO9000
C
 7130 CONTINUE
      GOTO9000
C
 7140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO SET (LINE) PATTERN--                         **
C               **  WRITE OUT A    W(P     PATTERN NUMBER)          **
C               **  WHERE PATTERN NUMBER IS 0 TO 6.                 **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGE 136                             **
C               ******************************************************
C
 8100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO8110
      IF(ICASE.EQ.'REGI')GOTO8120
      IF(ICASE.EQ.'MARK')GOTO8130
      IF(ICASE.EQ.'TEXT')GOTO8140
      GOTO8110
C
 8110 CONTINUE
      ICSTR(1:3)='W(P'
      NCSTR=3
      NCHTOT=1
      CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
      ICSTR(5:5)=')'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 8120 CONTINUE
      GOTO9000
C
 8130 CONTINUE
      GOTO9000
C
 8140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  TO SET (LINE) PATTERN--                         **
C               **  [ <X> <X> ...] <OFFSET> SETDASH                 **
C               **  THE FOLLOWING PATTERNS ARE USED, BUT THEY ARE   **
C               **  SCALED TO THE DOTS PER INCH (PATTERNS ARE FOR   **
C               **  72 DOTS PER INCH)                               **
C               **  [ 0 4 ] 0                                       **
C               **  [ ] 0                                           **
C               **  [ 2 4 ] 0                                       **
C               **  [ 4 4 ] 0                                       **
C               **  [ 4 2 ] 0                                       **
C               **  [ 6 4 2 4 ] 0                                   **
C               **  [ 6 4 4 4 ] 0                                   **
C               **  [ 6 4 4 4 2 4 ] 0                               **
C               **  REFERENCE--POSTSCRIPT LANGUAGE, TUTORIAL AND    **
C               **             COOKBOOK, ADOBE SYSTEMS              **
C               ******************************************************
CCCCC JUNE, 1990.  BUG FIX.  POSTSCRIPT DOES NOT SUPPORT A "NULL" LINE
CCCCC PATTERN.  SET TO SOLID, BUT IN GRDRPL, IF PATTERN IS ZERO, SKIP
CCCCC THE LINE.
C
 8600 CONTINUE
      ASCALE=PSTPPI/72.
      IF(ICASE.EQ.'LINE')GOTO8610
      IF(ICASE.EQ.'REGI')GOTO8620
      IF(ICASE.EQ.'MARK')GOTO8630
      IF(ICASE.EQ.'TEXT')GOTO8640
      GOTO8610
C
 8610 CONTINUE
      IF(JPATTT.EQ.0)GOTO8611
      IF(JPATTT.EQ.1)GOTO8612
      IF(JPATTT.EQ.2)GOTO8613
      IF(JPATTT.EQ.3)GOTO8614
      IF(JPATTT.EQ.4)GOTO8615
      IF(JPATTT.EQ.5)GOTO8616
      IF(JPATTT.EQ.6)GOTO8617
      IF(JPATTT.EQ.7)GOTO8618
      GOTO8611
C
 8611 CONTINUE
CCCCC ICSTR(1:4)='[ 0 '
CCCCC NCHTOT=5
CCCCC NCSTR=4
CCCCC IJUNK=INT(4.*ASCALE+0.5)
CCCCC IF(IJUNK.LE.1)IJUNK=4
CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(10:21)=' ] 0 setdash'
CCCCC NCSTR=21
      ICSTR(1:13)='[ ] 0 setdash'
      NCSTR=13
      GOTO8619
C
 8612 CONTINUE
      ICSTR(1:13)='[ ] 0 setdash'
      NCSTR=13
      GOTO8619
C
 8613 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(2.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=2
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:25)=' ] 0 setdash'
      NCSTR=25
      GOTO8619
C
 8614 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:25)=' ] 0 setdash'
      NCSTR=25
      GOTO8619
C
 8615 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(2.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=2
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:25)=' ] 0 setdash'
      NCSTR=25
      GOTO8619
C
 8616 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(6.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=6
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      IJUNK=INT(2.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=2
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:20)=' '
      NCSTR=20
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(26:37)=' ] 0 setdash'
      NCSTR=37
      GOTO8619
C
 8617 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(6.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=6
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      IJUNK=INT(6.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=6
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:20)=' '
      NCSTR=20
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(26:37)=' ] 0 setdash'
      NCSTR=37
      GOTO8619
C
 8618 CONTINUE
      ICSTR(1:2)='[ '
      NCHTOT=5
      NCSTR=2
      IJUNK=INT(6.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=6
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=' '
      NCSTR=8
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=' '
      NCSTR=14
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(20:20)=' '
      NCSTR=20
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(26:26)=' '
      NCSTR=26
      IJUNK=INT(2.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=2
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(32:32)=' '
      NCSTR=32
      IJUNK=INT(4.*ASCALE+0.5)
      IF(IJUNK.LE.1)IJUNK=4
      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
      ICSTR(38:49)=' ] 0 setdash'
      NCSTR=49
      GOTO8619
C
 8619 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
 8620 CONTINUE
      GOTO9000
C
 8630 CONTINUE
      GOTO9000
C
 8640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  TO SET (LINE) PATTERN--                         **
C               **  WRITE OUT A    ^V(PATTERN NUMBER)               **
C               **  HOWEVER, SET WHEN ACTUALLY DRAW LINE            **
C               **  WHERE PATTERN NUMBER IS 0 TO 9, A-F             **
C               **  REFERENCE--QUIC PROGRAMMERS MANUAL, FROM QMS    **
C               **             CHAPTER 14                           **
C               ******************************************************
C
 9100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO9110
      IF(ICASE.EQ.'REGI')GOTO9120
      IF(ICASE.EQ.'MARK')GOTO9130
      IF(ICASE.EQ.'TEXT')GOTO9140
      GOTO9110
C
 9110 CONTINUE
      GOTO9000
C
 9120 CONTINUE
      GOTO9000
C
 9130 CONTINUE
      GOTO9000
C
 9140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9000
      IF(ICASE.EQ.'LINE')GOTO9610
      IF(ICASE.EQ.'REGI')GOTO9620
      IF(ICASE.EQ.'MARK')GOTO9630
      IF(ICASE.EQ.'TEXT')GOTO9640
      GOTO9610
C
 9610 CONTINUE
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      ICODE=3
      INDEX=0
      IF(IX11CS.EQ.'ROUND')INDEX=1
      IF(IX11CS.EQ.'NOTLAST')INDEX=2
      IF(IX11CS.EQ.'PROJECT')INDEX=3
      CALL XLATTR(INDEX,ICODE)
      ICODE=4
      INDEX=0
      IF(IX11JS.EQ.'ROUND')INDEX=1
      IF(IX11JS.EQ.'BEVEL')INDEX=2
      CALL XLATTR(INDEX,ICODE)
      ICODE=2
      INDEX=0
      CALL XLATTR(JPATTT,ICODE)
      GOTO9000
C
 9620 CONTINUE
      GOTO9000
C
 9630 CONTINUE
      GOTO9000
C
 9640 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 74.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 310.                       **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 29.         **
C               *************************************************
C
10000 CONTINUE
      IF(ITCST.EQ.'CLOS')GOTO9000
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
      CALL TCSEPA(ICASE,IPATTT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO11010
      IF(ICASE.EQ.'REGI')GOTO11020
      IF(ICASE.EQ.'MARK')GOTO11030
      IF(ICASE.EQ.'TEXT')GOTO11040
      GOTO11010
C
11010 CONTINUE
CCCCC ADD FOLLOWING LINE OCTOBER 1996
      IF(JPATTT.EQ.-1)GOTO9000
CGKS  CALL GSLN(JPATTT)
      GOTO9000
C
11020 CONTINUE
      GOTO9000
C
11030 CONTINUE
      GOTO9000
C
11040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO12010
      IF(ICASE.EQ.'REGI')GOTO12020
      IF(ICASE.EQ.'MARK')GOTO12030
      IF(ICASE.EQ.'TEXT')GOTO12040
      GOTO12010
C
12010 CONTINUE
CCCCC CALL GDSEPA(JPATTT)
      GOTO9000
C
12020 CONTINUE
      GOTO9000
C
12030 CONTINUE
      GOTO9000
C
12040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO13010
      IF(ICASE.EQ.'REGI')GOTO13020
      IF(ICASE.EQ.'MARK')GOTO13030
      IF(ICASE.EQ.'TEXT')GOTO13040
      GOTO13010
C
13010 CONTINUE
      IF(JPATTT.EQ.-1)GOTO9000
      GOTO9000
C
13020 CONTINUE
      GOTO9000
C
13030 CONTINUE
      GOTO9000
C
13040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO13510
      IF(ICASE.EQ.'REGI')GOTO13520
      IF(ICASE.EQ.'MARK')GOTO13530
      IF(ICASE.EQ.'TEXT')GOTO13540
      GOTO13510
C
13510 CONTINUE
      IF(JPATTT.EQ.-1)GOTO9000
      GOTO9000
C
13520 CONTINUE
      GOTO9000
C
13530 CONTINUE
      GOTO9000
C
13540 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO14010
      IF(ICASE.EQ.'REGI')GOTO14020
      IF(ICASE.EQ.'MARK')GOTO14030
      IF(ICASE.EQ.'TEXT')GOTO14040
      GOTO14010
C
14010 CONTINUE
      IF(JPATTT.EQ.-1)GOTO9000
      GOTO9000
C
14020 CONTINUE
      GOTO9000
C
14030 CONTINUE
      GOTO9000
C
14040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEK (USING EEPIC)            DRIVER **
C               ******************************************************
C
15000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO15010
      IF(ICASE.EQ.'REGI')GOTO15020
      IF(ICASE.EQ.'MARK')GOTO15030
      IF(ICASE.EQ.'TEXT')GOTO15040
      GOTO15010
C
15010 CONTINUE
      GOTO9000
C
15020 CONTINUE
      GOTO9000
C
15030 CONTINUE
      GOTO9000
C
15040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO16010
      IF(ICASE.EQ.'REGI')GOTO16020
      IF(ICASE.EQ.'MARK')GOTO16030
      IF(ICASE.EQ.'TEXT')GOTO16040
      GOTO16010
C
16010 CONTINUE
      GOTO9000
C
16020 CONTINUE
      GOTO9000
C
16030 CONTINUE
      GOTO9000
C
16040 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSEPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IPATTT,JPATTT
 9013 FORMAT('IPATTT,JPATTT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PXSPA,PYSPA,PXSPA2,PYSPA2
 9014 FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IHORPA,IVERPA,IDUPPA,IDDOPA
 9015 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IMANUF,IMODEL
 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IGUNIT
 9019 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSEPP(I,
     1IPL1NU,
     1IPL2NU,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1IBUGO2,IFOUN2,IERROR)
C
C     PURPOSE--SCAN FOR PARTICULAR MANUFACTURERS FOR DEVICE I,
C              AND APPROPRIATELY UPDATE THE CONTINUITY, COLOR, AND
C              PICTURE POINT VECTORS.
C     NOTE--MANY OF THE PICTURE POINT SETTINGS HAVE BEEN ASSIGNED
C           VALUES OF 1000 AND 1000--THIS INDICATES THAT THE
C           ACTUAL COORECT VALUES ARE NOT KNOWN AND SHOULD
C           BE ASSIGNED THE PROPER VALUE IF SUCH A DEVICE
C           EXISTS AT ONE'S INSTALLATION.
C     INPUT  ARGUMENTS--
C                     --I
C                     --IDMANU
C                     --IDMODE
C                     --IDMOD2
C                     --IDMOD3
C     OUTPUT ARGUMENTS--
C                     --IDPOWE
C                     --IDCONT
C                     --IDCOLO
C                     --IDNVPP
C                     --IDNHPP
C                     --IFOUN2 ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. EMULATE ORIENTATION FOR SOME
C                                      DEVICES (BY ALAN HECKERT)
C     UPDATED         --MAY      1990. HP-GL UPDATES (BY ALAN HECKERT)
C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --AUGUST   1992. HP-GL FOR LASERJET III (ALAN)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN (ALAN)
C     UPDATED         --OCTOBER  1996. OPEN GL (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --NOVEMBER 1996. SUPPORT FOR
C                                      "LANDSCAPE WORDPERFECT"
C                                      FOR POSTSCRIPT DRIVER
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                                      CHANGE THIS TO "QUARTZ"
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                                      CHANGE THIS TO "GHOSTSCRIPT"
C     UPDATED         --MARCH    2002. ADD LATEX (EEPIC)
C     UPDATED         --MARCH    2002. ADD SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --JANUARY  2003. SUPPORT FOR ORIENTATION WHEN DEVICE
C                                      IS INITIALIZED.
C     UPDATED         --JANUARY  2003. SUPPORT FOR LANDSCAPE WORDPERFECT
C                                      ORIENTATION FOR POSTSCRIPT AND
C                                      OTHER DEVICES
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM DEVICE
C                                      USED WITH MAC OSX
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
C
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IC4
CCCCC CHARACTER*3 IC3
      CHARACTER*2 IC2
CCCCC CHARACTER*1 IC1
C
      CHARACTER*4 IBUGO2
      CHARACTER*4 IFOUN2
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
C
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
C  MAY, 1988.  ADD VERTICAL AND HORIZONTAL OFFSET PARAMETERS.
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C
C  MAY, 1988. ADD "GRAPHICS UNIT" FROM "DPCOGR" COMMON BLOCKS.
C
      COMMON/ICOMGU/IGUNIT,IPRGR,IRDGR
C
C  FEBRUARY, 2006. ADD "MACRO UNIT" FROM "DPCOF2" COMMON BLOCK.
C
      COMMON /ICOMI1/
     1IMESNU,
     1INEWNU,
     1IMAINU,
     1IHELNU,
     1IBUGNU,
     1IQUENU,
     1ISYSNU,
     1ILOGNU,
     1IDIRNU,
     1IDICNU,
     1IREANU,
     1IWRINU,
     1ISAVNU,
     1ILISNU,
     1ICRENU,
     1ICREN2,
     1ICAPNU
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUN2='NO'
      IERROR='NO'
C
      IDPOWE(I)='ON'
C
C  MAY, 1988.  SEPARATE UNITS FOR GRAPHICS.
CCCCC IDUNIT(I)=IPR
      IDUNIT(I)=IPRGR
      IF(I.EQ.2)IDUNIT(I)=IPL1NU
      IF(I.EQ.3)IDUNIT(I)=IPL2NU
C
C     ******************************************************************
C     **  FOLLOWING ARE EITHER ALPHANUMERIC TERMINALS OR LINE PRINTERS**
C     ******************************************************************
 
 
      IF(IDMANU(I).EQ.'ANDE')GOTO1100
      IF(IDMANU(I).EQ.'AJ')GOTO1100
      IF(IDMANU(I).EQ.'BATC')GOTO1200
      IF(IDMANU(I).EQ.'DISC')GOTO1300
      IF(IDMANU(I).EQ.'DTC')GOTO1400
      IF(IDMANU(I).EQ.'HAZE')GOTO1500
      IF(IDMANU(I).EQ.'OMRO')GOTO1600
      IF(IDMANU(I).EQ.'TELE')GOTO1700
      IF(IDMANU(I).EQ.'TERM')GOTO1800
      IF(IDMANU(I).EQ.'TEXA')GOTO1900
      IF(IDMANU(I).EQ.'TI')GOTO1900
C
C     ******************************************************************
C     **  FOLLOWING ARE METAFILES                                     **
C     **  (GENERAL, GENERAL CODED, METAFILE, FILE, CGM)               **
C     ******************************************************************
C
      IF(IDMANU(I).EQ.'FILE')GOTO2100
      IF(IDMANU(I).EQ.'META')GOTO2100
      IF(IDMANU(I).EQ.'GENE')GOTO2100
      IF(IDMANU(I).EQ.'CGM')GOTO2100
      IF(IDMANU(I).EQ.'CGMB')GOTO2100
C
C     ******************************************************************
C     **  FOLLOWING ARE CURRENTLY SUPPORTED DEVICES                   **
C     **                                                              **
C     **  1) TEKTRONIX   - (MODELS 4006, 4010, 4020, 4022, 4025, 4027 **
C     **                           4051, 4052, 4113, 4115, 4662, 4105 **
C     **                           4107, 4109, 4014, 4114)            **
C     **  2) HP          - HP-GL (9872, 7475, 7580)                   **
C     **                 -         7221 PLOTTER                       **
C     **                 -         2622 AND COMPATIBLE                **
C     **                           (2623, 2647, 2648, 9816, 9836,     **
C     **                                 2393, [MONOCHROME MODELS]    **
C     **                           2627, 2397, 2390 [8 COLORS])       **
C     **  3) CALCOMP     - REQUIRES LOCAL VERSION OF CALCOMP LIBRARY  **
C     **  4) ZETA        - REQUIRES LOCAL VERSION OF ZETA (A CALCOMP  **
C     **                   EXTENDED LIBRARY)                          **
C     **  5) REGIS       - ANY DEC TERMINAL RUNNING REGIS PROTOCOL    **
C     **  6) SUN         - USES SUN GRAPHICS LIBRARY                  **
C     **                   CODE IN DATAPLOT GRAPHICS ROUTINES NEEDS   **
C     **                   TO BE UNCOMMENTED)                         **
C     **  7) QUIC        - (EITHER LANDSCAPE OR PORTRAIT MODE)        **
C     **  8) POSTSCRIPT  - (EITHER LANDSCAPE OR PORTRAIT MODE)        **
C     **  9) X11         - (PICTURE POINTS CAN VARY)                  **
C     **  9) VGA/TURBO-C - REQUIRES TURBO-C 2.0 OR ABOVE              **
C     ** 10) LAHEY       - REQUIRES LAHEY COMPILER AND GRAPHICS LIB   **
C     ** 11) QWIN        - REQUIRES MICROSOFT COMPILER                **
C     ** 12) GKS         - REQUIRES A GKS LIBRARY                     **
C     ** 13) OPGL        - REQUIRES BILL MITCHELLS OPENGL             **
C     **                   FORTRAN 90 BINDING                         **
C     ** 14) GD          - REQUIRES GD LIBRARY                        **
C     **                   (JPEG, PNG, WINDOWS BMP)                   **
C     ** 15) PRIN        - PC PRINTERS FOR WINDOWS 95/98/NT           **
C     **                 - CHANGE TO GHOSTSCRIPT (OR GS)              **
C     ** 16) LATEX (EEPIC) - LATEX (USING EEPIC PACKAGE)              **
C     ** 17) MACINTOSH   - USE QUARTZ DRIVER                          **
C     ** 18) SVG         - SCALABLE VECTOR GRAPHICS                   **
C     ** 19) AQUATERM    - AQUATERM                                   **
C     ******************************************************************
C
      IF(IDMANU(I).EQ.'HEWL')GOTO6000
      IF(IDMANU(I).EQ.'HP')GOTO6000
      IF(IDMANU(I).EQ.'TEKT')GOTO6400
      IF(IDMANU(I).EQ.'ZETA')GOTO6900
      IF(IDMANU(I).EQ.'CALC')GOTO5400
      IF(IDMANU(I).EQ.'LAHE')GOTO15400
      IF(IDMANU(I).EQ.'REGI')GOTO7100
      IF(IDMANU(I).EQ.'VT')GOTO7100
      IF(IDMANU(I).EQ.'DEC')GOTO7100
      IF(IDMANU(I).EQ.'SUN')GOTO7200
      IF(IDMANU(I).EQ.'PCL')GOTO7300
      IF(IDMANU(I).EQ.'QUIC')GOTO7400
      IF(IDMANU(I).EQ.'QMS')GOTO7400
      IF(IDMANU(I).EQ.'POST')GOTO7500
      IF(IDMANU(I).EQ.'X11 ')GOTO7600
      IF(IDMANU(I).EQ.'TURB')GOTO7700
      IF(IDMANU(I).EQ.'LAHE')GOTO7800
      IF(IDMANU(I).EQ.'QWIN')GOTO7900
      IF(IDMANU(I).EQ.'GKS ')GOTO8000
      IF(IDMANU(I).EQ.'PRIN')GOTO8100
      IF(IDMANU(I).EQ.'GD  ')GOTO8200
      IF(IDMANU(I).EQ.'OPGL')GOTO8300
      IF(IDMANU(I).EQ.'APPL')GOTO5100
      IF(IDMANU(I).EQ.'MACI')GOTO5100
      IF(IDMANU(I).EQ.'QUAR')GOTO5100
      IF(IDMANU(I).EQ.'ABSO')GOTO5100
      IF(IDMANU(I).EQ.'LATE')GOTO8400
      IF(IDMANU(I).EQ.'EEPI')GOTO8400
      IF(IDMANU(I).EQ.'SVG ')GOTO8500
      IF(IDMANU(I).EQ.'AQUA')GOTO8600
C
C     ******************************************************************
C     **  FOLLOWING ARE CURRENTLY UNSUPPORTED DEVICES                 **
C     ******************************************************************
C
      IF(IDMANU(I).EQ.'BETA')GOTO5200
      IF(IDMANU(I).EQ.'BROO')GOTO5300
      IF(IDMANU(I).EQ.'COMP')GOTO5500
      IF(IDMANU(I).EQ.'FR80')GOTO5700
      IF(IDMANU(I).EQ.'GERB')GOTO5800
      IF(IDMANU(I).EQ.'GOUL')GOTO5900
      IF(IDMANU(I).EQ.'HOUS')GOTO6100
      IF(IDMANU(I).EQ.'HI')GOTO6100
      IF(IDMANU(I).EQ.'SC40')GOTO6200
      IF(IDMANU(I).EQ.'SING')GOTO6300
      IF(IDMANU(I).EQ.'VARI')GOTO6500
      IF(IDMANU(I).EQ.'VECT')GOTO6600
      IF(IDMANU(I).EQ.'VG')GOTO6600
      IF(IDMANU(I).EQ.'VERS')GOTO6700
      IF(IDMANU(I).EQ.'XYNE')GOTO6800
      IF(IDMANU(I).EQ.'RAMT')GOTO7000
      GOTO9000
C
C               ****************************************
C               **  TREAT THE ANDERSON JACOBSON CASE  **
C               ****************************************
C
 1100 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=132
      IDNVPP(I)=66
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ****************************
C               **  TREAT THE BATCH CASE  **
C               ****************************
C
 1200 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=132
      IDNVPP(I)=66
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE DISCRETE CASE  **
C               *******************************
C
 1300 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=72
      IDNVPP(I)=24
      IF(IDMODE(I).EQ.'WIDE')IDNHPP(I)=132
      IF(IDMODE(I).EQ.'WIDE')IDNVPP(I)=66
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               **************************
C               **  TREAT THE DTC CASE  **
C               **************************
C
 1400 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=132
      IDNVPP(I)=66
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ********************************
C               **  TREAT THE HAZELTINE CASE  **
C               ********************************
C
 1500 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=72
      IDNVPP(I)=24
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ****************************
C               **  TREAT THE OMRON CASE  **
C               ****************************
C
 1600 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=72
      IDNVPP(I)=24
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE TELETYPE CASE  **
C               *******************************
C
 1700 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=72
      IDNVPP(I)=24
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE TERMINET CASE  **
C               *******************************
C
 1800 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=132
      IDNVPP(I)=66
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ***************************************
C               **  TREAT THE TEXAS INSTRUMENT CASE  **
C               ***************************************
C
 1900 CONTINUE
      IDCONT(I)='OFF'
      IDCOLO(I)='OFF'
      IDNHPP(I)=72
      IDNVPP(I)=24
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE METAFILE CASE  **
C               *******************************
C
 2100 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=10000
      IDNVPP(I)=10000
      IF(IDMANU(I).EQ.'CGM')IDMODE(I)='CGM'
      IF(IDMANU(I).EQ.'CGM')IDMANU(I)='GENE'
      IF(IDMANU(I).EQ.'CGMB')IDMODE(I)='CGMB'
      IF(IDMANU(I).EQ.'CGMB')IDMANU(I)='GENE'
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ********************************
C               **  TREAT THE MACINTOSH CASE  **
C               **  BASED ON LIBRARY WITH THE **
C               **  ABSOFT COMPILER.          **
C               ********************************
C
C  NOTE: THIS DRIVER HAS NOT ACTUALLY BEEN DEVELOPED
C
 5100 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=600
      IDNVPP(I)=450
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=450
        IDNVPP(I)=600
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=450
        IDNVPP(I)=350
        IDNVOF(I)=125
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=450
        IDNVPP(I)=450
        IDNVOF(I)=0
        IDNHOF(I)=0
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5102)
 5102 FORMAT('MACINTOSH (BASED ON ABSOFT LIBRARY)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5110)
 5110 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)IDNHPP(I)
 5111 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)IDNVPP(I)
 5112 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO5190
C
 5190 CONTINUE
      IFOUN2='YES'
      GOTO8900
C
C               ******************************
C               **  TREAT THE BETACOM CASE  **
C               ******************************
C
 5200 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE BROOMALL CASE  **
C               *******************************
C
 5300 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ******************************
C               **  TREAT THE CALCOMP CASE  **
C               ******************************
C
 5400 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IF(ICALCL.GT.0)IDCOLO(I)='ON'
      IDNHPP(I)=INT(1000.*11.)
      IDNVPP(I)=INT(1000.*8.5)
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*11.)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*8.5)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*11.)
        IDNVOF(I)=INT(1000.*((11.0-7.73)/2))
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'POST')THEN
        IDNHPP(I)=INT(1000.*30.)
        IDNVPP(I)=INT(1000.*30.)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ENDIF
C
      GOTO8900
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
15400 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IF(ILAHNC.GT.0)IDCOLO(I)='ON'
      IF(IORNSW.EQ.'PORT')GOTO15410
      IF(IORNSW.EQ.'SQUA')GOTO15420
      IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
        IDNHPP(I)=600
        IDNVPP(I)=450
      ELSE
        IDNHPP(I)=INT(1000.*11.)
        IDNVPP(I)=INT(1000.*8.5)
      ENDIF
      GOTO15490
C
15410 CONTINUE
      IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
        IDNHPP(I)=450
        IDNVPP(I)=600
      ELSE
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*11.)
      ENDIF
      GOTO15490
C
15420 CONTINUE
      IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
        IDNHPP(I)=450
        IDNVPP(I)=450
      ELSE
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*8.5)
      ENDIF
      GOTO15490
C
15490 CONTINUE
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE COMPUTEK CASE  **
C               *******************************
C
 5500 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ***************************
C               **  TREAT THE FR80 CASE  **
C               ***************************
C
 5700 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *****************************
C               **  TREAT THE GERBER CASE  **
C               *****************************
C
 5800 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ****************************
C               **  TREAT THE GOULD CASE  **
C               ****************************
C
 5900 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               **********************************************************
C               **  TREAT THE HEWLETT PACKARD CASE                      **
C               **  REFERENCE--7221T OPERATING AND PROGRAMMING MANUAL,  **
C               **  PAGE 78                                             **
C               **  (FOR 2622 AND 2623) PAGE 10-1
C               **********************************************************
C
C  UPDATED MAY, 1990 FOR HP-GL.  ADD CHECK FOR MODEL NUMBER:
C  UPDATED AUGUST 1992.  CHECK FOR LASERJET III MODEL (TREAT AS 7475
C    BUT IS MONOCHROME, ADVANCE PAGE HANDLED SEPARATELY)
C    9872              - (4 PENS, 1 PAPER SIZE)
C    7475, 7550        - (8 PENS, 2 PAPER SIZES)
C    7580              - (8 PENS, 4 PAPER SIZES)
C    7585, 7586        - (8 PENS, 5 PAPER SIZES)
C    LJET, LASE, LJ    - (1 PEN, 1 PAPER SIZE)
C
C  FOLLOWING ANSI STANDARD PAPER SIZES RECOGNIZED:
C
C  A  - 8 1/2 X 11
C  B  - 11    X 17
C  C  - 17    X 22
C  D  - 22    X 34
C  E  - 34    X 44
C
C  NOTE THAT FOR HP-GL, THE "IP" POINTS DEFINE THE "SCALE" POINTS WHILE
C  THE "SC" POINTS DEFINE THE USER UNITS.  THAT IS, THE LOWER LEFT CORNER
C  SPECIFIED BY SC IS MAPPED TO THE LOWER LEFT SCALING POINT AND THE UPPER
C  RIGHT CORNER SPECIFIED BY SC IS MAPPED TO THE UPPER RIGHT SCALING POINT.
C  THAT IS, THE IP AND SC COMMANDS DEFINE THE WINDOW-TO-VIEWPORT MAPPING.
C  DATAPLOT DOES NOT SPECIFY THE IP PARAMETER BECAUSE MOST HP-GL PLOTTERS
C  ALLOW A USER TO MANUALLY SET THESE FROM THE PLOTTER AND WE DO NOT WANT
C  TO OVERIDE IF THEY HAVE SET IT.  WE SET THE SC PARAMETERS EQUAL TO THE
C  DEFAULT IP VALUES FOR THE GIVEN PLOTTER AND PAPER SIZE (EXCEPT FOR THE
C  7580/85/86 PLOTTERS WHICH USE NEGATIVE VALUES, FOR THESE WE DOUBLE THE
C  POSITIVE DISTANCE).  THIS MEANS WE PLOT IN ABSOLUTE PLOTTER UNITS.  WE
C  DO THIS SINCE DATAPLOT TYPICALLY WORKS IN "PICTURE POINT" UNITS ANYWAY
C  WHEN IT GETS TO THE DEVICE LEVEL.
C
C  UPDATED JULY, 1990 FOR HP 26XX MODELS.  SUPPORT COLOR ON SOME MODELS.
C
C  MODEL      RESOLUTION       COLORS
C  =====      ==========       ======
C  2622       512 X 390          0
C  2623       512 X 390          0
C  2647       720 X 360          0
C  2648       720 X 360          0
C  2393       512 X 390          0
C  9816       512 X 390          0
C  9836       512 X 390          0
C  2627       512 X 390          8
C  2397       512 X 390          8
C  2390       512 X 390          8
C
C  THESE MODELS ALL USE THE SAME DEVICE DRIVER.  THEY DIFFER ONLY IN THE
C  NUMBER OF PICTURE POINTS AND IN WHETHER THEY SUPPORT COLOR OR NOT.
C
 6000 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=16158
      IDNVPP(I)=11040
      IDNVOF(I)=0
      IDNHOF(I)=0
      IC4=IDMODE(I)
      IC2=IC4(1:2)
CCCCC FOLLOWING CODE MODIFIED JULY, 1990 FOR HP-26XX TYPE TERMINALS
CCCCC IF(IC2.EQ.'26')IDNHPP(I)=512
CCCCC IF(IC2.EQ.'26')IDNVPP(I)=390
CCCCC IF(IC2.EQ.'23')IDNHPP(I)=512
CCCCC IF(IC2.EQ.'23')IDNVPP(I)=390
CCCCC IF(IDMODE(I).EQ.'2647')IDNHPP(I)=720
CCCCC IF(IDMODE(I).EQ.'2647')IDNVPP(I)=360
CCCCC IF(IDMODE(I).EQ.'9816')IDNHPP(I)=512
CCCCC IF(IDMODE(I).EQ.'9816')IDNVPP(I)=390
CCCCC IF(IDMODE(I).EQ.'9836')IDNHPP(I)=512
CCCCC IF(IDMODE(I).EQ.'9836')IDNVPP(I)=390
CCCCC IF(IDMODE(I).EQ.'216')IDNHPP(I)=512
CCCCC IF(IDMODE(I).EQ.'216')IDNVPP(I)=390
CCCCC IF(IDMODE(I).EQ.'236')IDNHPP(I)=512
CCCCC IF(IDMODE(I).EQ.'236')IDNVPP(I)=390
      IF(IDMODE(I).EQ.'2627'.OR.IDMODE(I).EQ.'2397'.OR.
     1IDMODE(I).EQ.'2390')THEN
        IDNHPP(I)=512
        IDNVPP(I)=390
        IDCOLO(I)='ON'
        IDMODE(I)='2622'
      ELSE IF(IDMODE(I).EQ.'2647'.OR.IDMODE(I).EQ.'2648')THEN
        IDNHPP(I)=720
        IDNVPP(I)=360
        IDCOLO(I)='OFF'
        IDMODE(I)='2622'
      ELSE IF(IDMODE(I).EQ.'9816'.OR.IDMODE(I).EQ.'9836'.OR.
     1IDMODE(I).EQ.'2393'.OR.IDMODE(I).EQ.'2622'.OR.
     1IDMODE(I).EQ.'2623'.OR.IDMODE(I).EQ.'216'.OR.
     1IDMODE(I).EQ.'236'.OR.
     1IC2.EQ.'26')THEN
        IDNHPP(I)=512
        IDNVPP(I)=390
        IDCOLO(I)='OFF'
        IDMODE(I)='2622'
      END IF
      IF(IDMODE(I).EQ.'7221')IDNHPP(I)=3040
      IF(IDMODE(I).EQ.'7221')IDNVPP(I)=2000
CCCCC IF(IC2.EQ.'26')IDMODE(I)='2622'
CCCCC IF(IDMODE(I).EQ.'9816')IDMODE(I)='2622'
CCCCC IF(IDMODE(I).EQ.'9836')IDMODE(I)='2622'
CCCCC IF(IDMODE(I).EQ.'216')IDMODE(I)='2622'
CCCCC IF(IDMODE(I).EQ.'236')IDMODE(I)='2622'
      IF(IDMOD2(I).EQ.'7550')IDMOD2(I)='7475'
      IF(IDMOD2(I).EQ.'7586')IDMOD2(I)='7585'
CCCCC FOLLOWING LINES ADDED AUGUST 1992.  CHECK FOR LASER JET
      IF(IDMOD2(I).EQ.'LJET' .OR. IDMOD2(I).EQ.'LJ  ' .OR.
     1   IDMOD2(I).EQ.'LASE')THEN
        IDMOD3(I)='LJET'
        IDMOD2(I)='7475'
      ENDIF
CCCCC FOLLOWING LINES ADDED MARCH, 1990.
CCCCC FOLLOWING MODIFIED JULY, 1990 (DISTINGUISH 2647 BY PICTURE POINTS)
CCCCC IF(IDMODE(I).EQ.'2622')THEN
      IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.512)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=302
          IDNHOF(I)=45
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=390
          IDNHOF(I)=60
        END IF
CCCCC ELSE IF(IDMODE(I).EQ.'2647')THEN
      ELSE IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.720)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=278
          IDNHOF(I)=221
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=369
          IDNHOF(I)=180
        ELSE IF(IORNSW.EQ.'LAND')THEN
          IDNHPP(I)=466
          IDNHOF(I)=127
        END IF
      ELSE IF(IDMODE(I).EQ.'GL  ')THEN
        IGUNIT=IDUNIT(I)
        IF(IDMOD2(I).EQ.'7475')THEN
          IHPGCL=8
          IF(IDMOD3(I).EQ.'B   ')THEN
            IDNHPP(I)=16640
            IDNVPP(I)=10365
CCCCC  AUGUST 1992.  ADD FOLLOWING 4 LINES
          ELSEIF(IDMOD3(I).EQ.'LJET')THEN
            IHPGCL=1
            IDNHPP(I)=10250
            IDNVPP(I)=7796
          ELSE
            IDNHPP(I)=10250
            IDNVPP(I)=7796
          END IF
        ELSE IF(IDMOD2(I).EQ.'7580')THEN
          IHPGCL=8
          IF(IDMOD3(I).EQ.'B   ')THEN
            IDNHPP(I)=14200
            IDNVPP(I)=9000
          ELSE IF(IDMOD3(I).EQ.'C   ')THEN
            IDNHPP(I)=19280
            IDNVPP(I)=16566
          ELSE IF(IDMOD3(I).EQ.'D   ')THEN
            IDNHPP(I)=20120
            IDNVPP(I)=30340
          ELSE
            IDNHPP(I)=5580
            IDNVPP(I)=9000
          END IF
        ELSE IF(IDMOD2(I).EQ.'7585')THEN
          IHPGCL=8
          IF(IDMOD3(I).EQ.'B   ')THEN
            IDNHPP(I)=14200
            IDNVPP(I)=9000
          ELSE IF(IDMOD3(I).EQ.'C   ')THEN
            IDNHPP(I)=14180
            IDNVPP(I)=20150
          ELSE IF(IDMOD3(I).EQ.'D   ')THEN
            IDNHPP(I)=20120
            IDNVPP(I)=30340
          ELSE IF(IDMOD3(I).EQ.'E   ')THEN
            IDNHPP(I)=41680
            IDNVPP(I)=32360
          ELSE
            IDNHPP(I)=5580
            IDNVPP(I)=9000
          END IF
        ELSE
          IHPGCL=4
          IDMOD2(I)='9872'
          IDNHPP(I)=16158
          IDNVPP(I)=11040
        END IF
        IHPGX=IDNHPP(I)
        IHPGY=IDNVPP(I)
        IF(IORNSW.EQ.'PORT')THEN
          ASPECT=8.5/11.
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          ASPECT=1.
        ELSE IF(IORNSW.EQ.'LAND')THEN
          ASPECT=11./8.5
        ELSE
          ASPECT=-1.0
        END IF
        IF(ASPECT.GT.0.0)THEN
          IXMIN=0
          IXMAX=IDNHPP(I)
          IYMIN=0
          IYMAX=IDNVPP(I)
          XDIST=REAL(IXMAX-IXMIN+1)
          YDIST=REAL(IYMAX-IYMIN+1)
          XSIZE=YDIST*ASPECT
          IF(XSIZE.GT.REAL(IXMAX))XSIZE=REAL(IXMAX)
          XOFF=(XDIST-XSIZE)/2.
          IF(XOFF.LT.0.)XOFF=0.
          IDNHPP(I)=INT(XSIZE+0.5)
          IDNHOF(I)=INT(XOFF+0.5)
        END IF
      END IF
      IF(IHPGCL.LE.4)THEN
        IHPGPM(1)='BLACK'
        IHPGPM(2)='RED '
        IHPGPM(3)='BLUE'
        IHPGPM(4)='GREEN'
        DO6050J=5,16
        ITEMP=MOD(J-1,4)+1
        IHPGPM(J)=IHPGPM(ITEMP)
 6050   CONTINUE
      ELSE
        IHPGPM(1)='BLACK'
        IHPGPM(2)='RED '
        IHPGPM(3)='BLUE'
        IHPGPM(4)='GREEN'
        IHPGPM(5)='MAGENTA'
        IHPGPM(6)='ORANGE'
        IHPGPM(7)='CYAN'
        IHPGPM(8)='YELLOW'
        DO6060J=9,16
        ITEMP=J-8
        IHPGPM(J)=IHPGPM(ITEMP)
 6060   CONTINUE
      END IF
CCCCC END CHANGE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      IF(IDMODE(I).EQ.'2622')GOTO6020
C  MAY, 1990.  CHANGE MESSAGE BASED ON 4 OR 8 PEN PLOTTERS.
      IF(IDMODE(I).EQ.'7221')WRITE(ICOUT,6001)
 6001 FORMAT('HEWLETT-PACKARD 7221T')
      IF(IDMODE(I).EQ.'7221')CALL DPWRST('XXX','BUG ')
      IF(IDMODE(I).NE.'7221')WRITE(ICOUT,6002)
 6002 FORMAT('HEWLETT-PACKARD WITH HP-GL')
      IF(IDMODE(I).NE.'7221')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6010)
 6010 FORMAT('PEN SETTINGS--')
      CALL DPWRST('XXX','BUG ')
C
      IF(IDMODE(I).NE.'7221')GOTO6070
      WRITE(ICOUT,6011)
 6011 FORMAT(12X,'PEN 1 = BLACK (3 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6012)
 6012 FORMAT(12X,'PEN 2 = RED   (3 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6013)
 6013 FORMAT(12X,'PEN 3 = BLUE  (3 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6014)
 6014 FORMAT(12X,'PEN 4 = GREEN (3 MM)')
      CALL DPWRST('XXX','BUG ')
      GOTO6090
C
 6020 CONTINUE
      WRITE(ICOUT,6021)
 6021 FORMAT('HEWLETT-PACKARD 26XX-TYPE TERMINAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6022)
 6022 FORMAT('INCLUDING 981X, 983X, 21X, 23X TERMINALS')
      CALL DPWRST('XXX','BUG ')
      GOTO6090
C
 6070 CONTINUE
      DO6079J=1,IHPGCL
      WRITE(ICOUT,6072)J,IHPGPM(J)
 6072 FORMAT('PEN ',I2,' = ',A8,'(3 MM)')
      CALL DPWRST('XXX','BUG ')
 6079 CONTINUE
      GOTO6090
C
 6090 CONTINUE
      GOTO8900
C
C               *****************************************
C               **  TREAT THE HOUSTON INSTRUMENT CASE  **
C               *****************************************
C
 6100 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *****************************
C               **  TREAT THE SC4020 CASE  **
C               *****************************
C
 6200 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *****************************
C               **  TREAT THE SINGER CASE  **
C               *****************************
C
 6300 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ********************************
C               **  TREAT THE TEKTRONIX CASE  **
C               ********************************
C
 6400 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IF(IDMODE(I).EQ.'4027')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4105')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4113')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON'
      IF(IDMODE(I).EQ.'4662')IDCOLO(I)='ON'
C
      IDNHPP(I)=4096
      IDNVPP(I)=3124
      IF(IDMODE(I).EQ.'4006')IDNHPP(I)=1024
      IF(IDMODE(I).EQ.'4006')IDNVPP(I)=781
      IF(IDMODE(I).EQ.'4010')IDNHPP(I)=1024
      IF(IDMODE(I).EQ.'4010')IDNVPP(I)=781
      IF(IDMODE(I).EQ.'4020')IDNHPP(I)=640
      IF(IDMODE(I).EQ.'4020')IDNVPP(I)=480
      IF(IDMODE(I).EQ.'4022')IDNHPP(I)=640
      IF(IDMODE(I).EQ.'4022')IDNVPP(I)=480
      IF(IDMODE(I).EQ.'4025')IDNHPP(I)=640
      IF(IDMODE(I).EQ.'4025')IDNVPP(I)=480
      IF(IDMODE(I).EQ.'4027')IDNHPP(I)=640
      IF(IDMODE(I).EQ.'4027')IDNVPP(I)=480
      IF(IDMODE(I).EQ.'4051')IDNHPP(I)=1024
      IF(IDMODE(I).EQ.'4051')IDNVPP(I)=781
      IF(IDMODE(I).EQ.'4052')IDNHPP(I)=1024
      IF(IDMODE(I).EQ.'4052')IDNVPP(I)=781
CCCCC IF(IDMODE(I).EQ.'4105')IDNHPP(I)=480
CCCCC IF(IDMODE(I).EQ.'4105')IDNVPP(I)=360
CCCCC IF(IDMODE(I).EQ.'4107')IDNHPP(I)=480
CCCCC IF(IDMODE(I).EQ.'4107')IDNVPP(I)=360
CCCCC IF(IDMODE(I).EQ.'4109')IDNHPP(I)=480
CCCCC IF(IDMODE(I).EQ.'4109')IDNVPP(I)=360
      IF(IDMODE(I).EQ.'4113')IDNHPP(I)=1000
      IF(IDMODE(I).EQ.'4113')IDNVPP(I)=800
      IF(IDMODE(I).EQ.'4115')IDNHPP(I)=1000
      IF(IDMODE(I).EQ.'4115')IDNVPP(I)=800
      IDNVOF(I)=0
      IDNHOF(I)=0
CCCCC FOLLOWING LINES ADDED MARCH, 1990.
      IF(IDNHPP(I).EQ.4096)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=2414
          IDNHOF(I)=841
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=3124
          IDNHOF(I)=486
        END IF
      ELSE IF(IDNHPP(I).EQ.1024)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=603
          IDNHOF(I)=89
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=781
          IDNHOF(I)=121
        END IF
      ELSE IF(IDNHPP(I).EQ.640)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=371
          IDNHOF(I)=54
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=480
          IDNHOF(I)=80
        END IF
      ELSE IF(IDNHPP(I).EQ.1000)THEN
        IF(IORNSW.EQ.'PORT')THEN
          IDNHPP(I)=618
          IDNHOF(I)=191
        ELSE IF(IORNSW.EQ.'SQUA')THEN
          IDNHPP(I)=800
          IDNHOF(I)=100
        END IF
      END IF
      IF(IDMODE(I).EQ.'4662')GOTO6410
      GOTO6490
 6410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6411)
 6411 FORMAT('TEKTRONIX 4662 MULTI-PEN PLOTTER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6412)
 6412 FORMAT('PEN SETTINGS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6413)
 6413 FORMAT(12X,'PEN 1 = BLACK (3.5 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6414)
 6414 FORMAT(12X,'PEN 2 = RED   (3.5 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6415)
 6415 FORMAT(12X,'PEN 3 = BLUE  (3.5 MM)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6416)
 6416 FORMAT(12X,'PEN 4 = GREEN (3.5 MM)')
      CALL DPWRST('XXX','BUG ')
 6490 CONTINUE
      GOTO8900
C
C               *****************************
C               **  TREAT THE VARIAN CASE  **
C               *****************************
C
 6500 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *************************************
C               **  TREAT THE VECTOR GENERAL CASE  **
C               *************************************
C
 6600 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE VERSATEC CASE  **
C               *******************************
C
 6700 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1560
      IDNVPP(I)=2080
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *******************************
C               **  TREAT THE XYNETICS CASE  **
C               *******************************
C
 6800 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ***************************
C               **  TREAT THE ZETA CASE  **
C               ***************************
C
 6900 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IF(IZETCL.GT.0)IDCOLO(I)='ON'
      IDNHPP(I)=INT(1000.*11.)
      IDNVPP(I)=INT(1000.*8.5)
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*11.)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*8.5)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=INT(1000.*8.5)
        IDNVPP(I)=INT(1000.*11.)
        IDNVOF(I)=INT(1000.*((11.0-7.73)/2))
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'POST')THEN
        IDNHPP(I)=INT(1000.*30.)
        IDNVPP(I)=INT(1000.*30.)
        IDNVOF(I)=0
        IDNHOF(I)=0
      ENDIF
C
      GOTO8900
C
C               ***************************
C               **  TREAT THE RAMTEK CASE**
C               ***************************
C
 7000 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 100                            **
C               ******************************************************
C
 7100 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=768
      IDNVPP(I)=480
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=371
        IDNHOF(I)=198
      ELSE IF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=480
        IDNHOF(I)=144
      ELSE IF(IORNSW.EQ.'LAND')THEN
        IDNHPP(I)=621
        IDNHOF(I)=73
      ELSE IF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=621
        IDNHOF(I)=73
      END IF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7102)
 7102 FORMAT('DEC WITH REGIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7110)
 7110 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7111)IDNHPP(I)
 7111 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7112)IDNVPP(I)
 7112 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
C               ******************************************************
C               **  TREAT THE SUN        CASE                       **
C               ******************************************************
C
 7200 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDUMMY=0
CSUN  CALL isitcolor(IDUMMY)
      ISUNCL=IDUMMY
      IF(ISUNCL.GT.0)IDCOLO(I)='ON'
      IDNHPP(I)=10000
      IDNVPP(I)=10000
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ******************************************************
C               **  TREAT THE PCL        CASE                       **
C               ******************************************************
C
 7300 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=(11.*PCLPPI)-(IPCLLM+IPCLRM)
      IDNVPP(I)=(8.5*PCLPPI)-(IPCLTM+IPCLBM)
      IF(IORNSW.EQ.'PORT')IDNHPP(I)=(8.5*PCLPPI)-(IPC2LM+IPC2RM)
      IF(IORNSW.EQ.'PORT')IDNVPP(I)=(11.*PCLPPI)-(IPC2TM+IPC2BM)
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C               ******************************************************
C               **  TREAT THE QUIC       CASE                       **
C               ******************************************************
C
 7400 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
      IDNHPP(I)=(11.*QUIPPI)-(IQUILM+IQUIRM)
      IDNVPP(I)=(8.5*QUIPPI)-(IQUITM+IQUIBM)
      IF(IORNSW.EQ.'PORT')IDNHPP(I)=(8.5*QUIPPI)-(IQU2LM+IQU2RM)
      IF(IORNSW.EQ.'PORT')IDNVPP(I)=(11.*QUIPPI)-(IQU2TM+IQU2BM)
      IDNVOF(I)=IQUITM
      IDNHOF(I)=IQUILM
      IF(IORNSW.EQ.'PORT')IDNVOF(I)=IQU2TM
      IF(IORNSW.EQ.'PORT')IDNHOF(I)=IQU2LM
      GOTO8900
C
C               ******************************************************
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
C  NOVEMBER, 1990 BUG FIX.  SET OFFSETS TO 0 (WERE GETTING DOUBLE COUNTED).
C  ALSO FIXED GRINDE, GRERSC.
C
 7500 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='OFF'
CCCCC JUNE 2004: ADD FOLLOWING LINE.  SET POSTSCRIPT DEFAULT
CCCCC            COLOR <ON/OFF> DETERMINES IF DEVICE INITIALIZES
CCCCC            IN COLOR.
C
      IF(IPSTDC.EQ.'ON')IDCOLO(I)='ON'
      IDNHPP(I)=(11.*PSTPPI)-(IPSTLM+IPSTRM)
      IDNVPP(I)=(8.5*PSTPPI)-(IPSTTM+IPSTBM)
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=(8.5*PSTPPI)-(IPS2LM+IPS2RM)
        IDNVPP(I)=(11.*PSTPPI)-(IPS2TM+IPS2BM)
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=(8.5*PSTPPI)-(IPSTLM+IPSTRM)
        IDNVPP(I)=(6.5*PSTPPI)-(IPSTTM+IPSTBM)
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=(8.5*PSTPPI)-(IPSTLM+IPSTRM)
        IDNVPP(I)=(8.5*PSTPPI)-(IPSTTM+IPSTBM)
      ENDIF
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               ******************************************************
C               **  TREAT THE X11        CASE                       **
C               **  ACTUAL PICTURE POINTS CAN VARY (BOTH BECAUSE    **
C               **  DIFFERENT WORKSTATIONS SUPPORTED AND BECAUSE    **
C               **  RESIDENT WINDOW MANAGER CAN MODIFY REQUESTED    **
C               **  PICTURE POINTS.  SET TO 0 HERE (THE X11 C LIBRARY*
C               **  WILL SET DEFAULT VALUES.  USER CAN SPECIFY A    **
C               **  SUGGESTED SIZE VIA DEVICE .. PICTURE POINTS.    **
C               **  THE X11 C LIBRARY WILL QUERY THE COLOR          **
C               **  CAPABILITY OF THE SPECIFIC WORKSTATION.         **
C               ******************************************************
C
 7600 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=0
      IDNVPP(I)=0
      IDNVOF(I)=0
      IDNHOF(I)=0
      GOTO8900
C
C               *************************************************
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 105.         **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 200.                       **
C               *************************************************
C
 7700 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=640
      IDNVPP(I)=480
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7702)
 7702 FORMAT('TURBO-C/VGA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7710)
 7710 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7711)IDNHPP(I)
 7711 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7712)IDNVPP(I)
 7712 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
C               *************************************************
C               **  TREAT THE LAHEY                 CASE       **
C               **  REFERENCE--LAHEY REFERENCE MANUAL          **
C               *************************************************
C
 7800 CONTINUE
      IF(IDMODE(I).EQ.'INTE')GOTO7820
      IF(IDMODE(I).EQ.'WINT')GOTO7830
C
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=640
      IDNVPP(I)=480
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7802)
 7802 FORMAT('LAHEY      ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7810)
 7810 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7811)IDNHPP(I)
 7811 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7812)IDNVPP(I)
 7812 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
 7820 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=800
      IDNVPP(I)=600
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7821)
 7821 FORMAT('LAHEY (INTERACTOR) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7823)
 7823 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7825)IDNHPP(I)
 7825 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7827)IDNVPP(I)
 7827 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
 7830 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7831)
 7831 FORMAT('LAHEY (INTERACTOR) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7833)
 7833 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7835)IDNHPP(I)
 7835 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7837)IDNVPP(I)
 7837 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
C               *************************************************
C               **  TREAT THE MICROSOFT QWIN        CASE       **
C               **  REFERENCE--MICROSOFT FORTRAN MANUAL        **
C               *************************************************
C
 7900 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=-1
      IDNVPP(I)=-1
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7902)
 7902 FORMAT('MICROSOFT QUICK-WIN DRIVER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7910)
 7910 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7911)IDNHPP(I)
 7911 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7912)IDNVPP(I)
 7912 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
C               *************************************************
C               **  TREAT THE GKS                   CASE       **
C               *************************************************
C
 8000 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8002)
 8002 FORMAT('TURBO-C/VGA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8010)
 8010 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)IDNHPP(I)
 8011 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)IDNVPP(I)
 8012 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
C               *************************************************
C               **  TREAT THE PC PRINTER            CASE       **
C               *************************************************
C
 8100 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=1000
      IDNVPP(I)=1000
      IDNVOF(I)=0
      IDNHOF(I)=0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8102)
 8102 FORMAT('TURBO-C/VGA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8110)
 8110 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)IDNHPP(I)
 8111 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDNVPP(I)
 8112 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8900
C
 8900 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               *************************************************
C               **  TREAT THE GD                    CASE       **
C               *************************************************
C
 8200 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=600
      IDNVPP(I)=465
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=465
        IDNVPP(I)=600
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=465
        IDNVPP(I)=360
        IDNVOF(I)=220
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=465
        IDNVPP(I)=465
        IDNVOF(I)=0
        IDNHOF(I)=0
      ENDIF
      IDFONT(I)='SIMP'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8202)IDMODE(I)
 8202 FORMAT('GD LIBRARY--',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8210)
 8210 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8211)IDNHPP(I)
 8211 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8212)IDNVPP(I)
 8212 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8290
C
 8290 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               *************************************************
C               **  TREAT THE OPEN-GL               CASE       **
C               *************************************************
C
 8300 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=600
      IDNVPP(I)=450
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=450
        IDNVPP(I)=600
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=450
        IDNVPP(I)=350
        IDNVOF(I)=125
        IDNHOF(I)=0
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8302)
 8302 FORMAT('OPEN-GL (BASED ON f90gl)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8310)
 8310 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8311)IDNHPP(I)
 8311 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8312)IDNVPP(I)
 8312 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8390
C
 8390 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               ****************************************************
C               **  TREAT THE LATEX CASE--                        **
C               **  USE 72 DPI COORDINATE SCALE STARTING FROM     **
C               **  LOWER LEFT CORNER.  SUPPORT PORTRAIT AND      **
C               **  LANDSCAPE WORDPERFECT OPTIONS.  REGULAR       **
C               **  LANDSCAPE MODE WILL BE TREATED SAME AS        **
C               **  LANDSCAPE WORDPERFECT (I.E., LANDSCAPE        **
C               **  MODE IN A PORTRAIT PAGE).                     **
C               ****************************************************
C
 8400 CONTINUE
C
C  NOTE: IF CAPTURE SWITCH IS ON AND THIS IS DEVICE 1, THEN
C        SET IGUNIT EQUAL TO CAPTURE FILE.
C
      IFLAG9=0
      IF(I.EQ.1 .AND. IPR.EQ.ICAPNU)THEN
        IGUNIT=ICAPNU
        IFLAG9=1
      ENDIF
      IDNVOF(I)=0
      IDNHOF(I)=0
      ADOTPI=300.0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=6.25*ADOTPI
        IDNVPP(I)=9.0*ADOTPI
      ELSEIF(IORNSW.EQ.'LAND')THEN
        IDNHPP(I)=6.25*ADOTPI
        IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0)
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=6.25*ADOTPI
        IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0)
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=6.0*ADOTPI
        IDNVPP(I)=6.0*ADOTPI
      ELSE
        IDNHPP(I)=6.25*ADOTPI
        IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0)
      ENDIF
      IF(IFLAG9.EQ.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8402)IDMODE(I)
 8402   FORMAT('LATEX (USING EPIC/EEPIC/GRAPHICS)--',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8410)
 8410   FORMAT('PICTURE POINTS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8411)IDNHPP(I)
 8411   FORMAT(12X,'HORIZONTAL = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8412)IDNVPP(I)
 8412   FORMAT(12X,'VERTICAL   = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO8490
C
 8490 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               ****************************************************
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS CASE) **
C               ****************************************************
C
 8500 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=600
      IDNVPP(I)=465
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=465
        IDNVPP(I)=600
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=465
        IDNVPP(I)=360
        IDNVOF(I)=220
        IDNHOF(I)=0
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8502)IDMODE(I)
 8502 FORMAT('SCALABLE VECTOR GRAPHICS (SVG)--',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8510)
 8510 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8511)IDNHPP(I)
 8511 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8512)IDNVPP(I)
 8512 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO8590
C
 8590 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               ****************************************************
C               **  TREAT THE AQUATERM (MAC OSX) CASE             **
C               ****************************************************
C
 8600 CONTINUE
      IDCONT(I)='ON'
      IDCOLO(I)='ON'
      IDNHPP(I)=600
      IDNVPP(I)=450
      IDNVOF(I)=0
      IDNHOF(I)=0
      IF(IORNSW.EQ.'PORT')THEN
        IDNHPP(I)=450
        IDNVPP(I)=600
      ELSEIF(IORNSW.EQ.'LAN2')THEN
        IDNHPP(I)=450
        IDNVPP(I)=350
        IDNVOF(I)=125
        IDNHOF(I)=0
      ELSEIF(IORNSW.EQ.'SQUA')THEN
        IDNHPP(I)=450
        IDNVPP(I)=450
        IDNVOF(I)=0
        IDNHOF(I)=0
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8602)
 8602 FORMAT('AQUATERM (FOR MAC OSX)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8610)
 8610 FORMAT('PICTURE POINTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8611)IDNHPP(I)
 8611 FORMAT(12X,'HORIZONTAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8612)IDNVPP(I)
 8612 FORMAT(12X,'VERTICAL   = ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO5190
C
 8690 CONTINUE
      IFOUN2='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE GRSESI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A SIZE (E.G., A CHARACTER SIZE)
C              (HEIGHT, WIDTH,
C              VERTICAL GAP, HORIZONTAL GAP9
C              GIVEN IN (0.0 TO 100.0) REPRESENTATION
C              INTO AN INTEGER NUMERIC REPRESENTATION (IN JSIZE)
C              THAT WILL BE UNDERSTOOD BY THE TEKTRONIX
C              GRAPHICS DEVICE BEING USED.
C              ALSO, CREATE OTHER VARIABLES WHICH CONTAIN
C              THE CLOSEST ALLOWABLE SIZES
C              (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON
C              THE TEKTRONIX GRAPHICS DEVICE BEING USED.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PVONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MARCH    1991. REGIS FIX (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. SUPPORT FOR LATEX
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC FOLLOWING LINES FOR MICROSOFT FORTRAN  OCTOBER 1996
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF TYPE(FONTINFO) MSFONT
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
      CHARACTER*1 IQUOTE
C
      CHARACTER*4 ICASE
      CHARACTER*4 IFONT
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      CALL DPCONA(39,IQUOTE)
      ISUBN0='SESI'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      PVETO2=(-999.0)
      PHOTO2=(-999.0)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SESI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSESI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE,IFONT
   52 FORMAT('ICASE,IFONT = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   53 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)JSIZE
   54 FORMAT('JSIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)JHEIG2,JWIDT2,JVEGA2,JHOGA2
   55 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PHEIG2,PWIDT2,PVEGA2,PHOGA2
   56 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IMANUF,IMODEL
   57 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4012')GOTO1100
      IF(IMODEL.EQ.'4013')GOTO1100
      IF(IMODEL.EQ.'4014')GOTO1100
      IF(IMODEL.EQ.'4015')GOTO1100
      IF(IMODEL.EQ.'4016')GOTO1100
C
      IF(IMODEL.EQ.'4054')GOTO1100
C
      IF(IMODEL.EQ.'4113')GOTO1100
      IF(IMODEL.EQ.'4114')GOTO1100
C
      IF(IMODEL.EQ.'4662')GOTO1200
C
      GOTO9000
C
 1010 CONTINUE
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      IF(IMODEL.EQ.'7221')GOTO2100
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
C               ****************************************************************
C               **  STEP 11--
C               **  TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, AND 4114
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES
C               **  WHICH ARE LARGE SCREEN AND SO HAVE
C               **  4 CHARCTER SIZES.)
C               **  REFERENCE--XXX
C               ****************************************************************
C
 1100 CONTINUE
CCCCC IF(JSIZE.EQ.1)WRITE(IGUNIT,1111)IESCC
C1111 FORMAT(A1,';')
CCCCC IF(JSIZE.EQ.2)WRITE(IGUNIT,1112)IESCC
C1112 FORMAT(A1,':')
CCCCC IF(JSIZE.EQ.3)WRITE(IGUNIT,1113)IESCC
C1113 FORMAT(A1,'9')
CCCCC IF(JSIZE.EQ.4)WRITE(IGUNIT,1114)IESCC
C1114 FORMAT(A1,'8')
      ICSTR(1:1)=IESCC
      ICSTR(2:2)=';'
CCCCC IF(JSIZE.EQ.1)ICSTR(2:2)=';'
      IF(JSIZE.EQ.2)ICSTR(2:2)=':'
      IF(JSIZE.EQ.3)ICSTR(2:2)='9'
      IF(JSIZE.EQ.4)ICSTR(2:2)='8'
      NCSTR=2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ****************************************************************
C               **  STEP 12--
C               **  TREAT THE TEKTRONIX 4662 PENPLOTTER CASE               **
C               **  REFERENCE--XXX
C               ****************************************************************
C
 1200 CONTINUE
CCCCC IF(JSIZE.EQ.1)WRITE(IGUNIT,1211)IESCC
C1211 FORMAT(A1,'AI31,48')
CCCCC IF(JSIZE.EQ.2)WRITE(IGUNIT,1212)IESCC
C1212 FORMAT(A1,'AI34,53')
CCCCC IF(JSIZE.EQ.3)WRITE(IGUNIT,1213)IESCC
C1213 FORMAT(A1,'AI51,82')
CCCCC IF(JSIZE.EQ.4)WRITE(IGUNIT,1214)IESCC
C1214 FORMAT(A1,'AI56,88')
      ICSTR(1:1)=IESCC
      ICSTR(2:8)='AI31,48'
CCCCC IF(JSIZE.EQ.1)ICSTR(2:8)='AI31,48'
      IF(JSIZE.EQ.2)ICSTR(2:8)='AI34,53'
      IF(JSIZE.EQ.3)ICSTR(2:8)='AI51,82'
      IF(JSIZE.EQ.4)ICSTR(2:8)='AI56,88'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO SET SIZE--                                   **
C               **  USE THE TILDA PERCENT (= LABEL SIZE) INSTRUCTION           *
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 119-121.                        **
C               ******************************************************
C
 2100 CONTINUE
      ICSTR(1:2)='~%'
      NCSTR=2
      PVETO2=PHEIG2+PVEGA2
      PHOTO2=PWIDT2+PHOGA2
      CALL GRTRSD(PHOTO2,PVETO2,IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO SET SIZE--                                   **
C               **  USE THE SR (= REL CHAR SIZE) INSTRUCTION        **
C               **  ALONG WITH FLOATING POINT COORDINATES,          **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 84-85, 144.                     **
C               ******************************************************
C
 2200 CONTINUE
CCCCC WRITE(IGUNIT,2211)PWIDT2,PHEIG2
C2211 FORMAT('SR',F10.1,',',F10.1,';')
      ICSTR(1:2)='SR'
      NCSTR=2
      NCHTOT=10
      NCHDEC=1
      CALL GRTRRE(PWIDT2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(13:13)=','
      NCSTR=13
      CALL GRTRRE(PHEIG2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(24:24)=';'
      NCSTR=24
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2290 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-19, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
C     NEEDS MORE WORK FOR FULL 8 SIZES
      ICSTR(1:1)=IESCC
      ICSTR(2:6)='*m1mZ'
      IF(PHEIG2.GT.3.0)ICSTR(2:6)='*m2mZ'
      IF(PHEIG2.GT.6.0)ICSTR(2:6)='*m3mZ'
      IF(PHEIG2.GT.9.0)ICSTR(2:6)='*m4mZ'
      IF(PHEIG2.GT.11.0)ICSTR(2:6)='*m5mZ'
      IF(PHEIG2.GT.14.0)ICSTR(2:6)='*m6mZ'
      IF(PHEIG2.GT.17.0)ICSTR(2:6)='*m8mZ'
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **  HP LASERJET LASER PRINTERS                          **
C               **  SIZE DETERMINED BY WHICH OF THE 3 BUILT IN FONTS ARE**
C               **  USED.  CURRENTLY NO SUPPORT FOR DOWNLOADABLE FONTS  **
C               **  1.  COURIER MEDIUM (DEFAULT) - 12 PT, 10 CPI        **
C               **  2.  COURIER BOLD             - 12 PT, 10 CPI        **
C               **  3.  CONDENSED LINE PRINTER   - 8.5 PT, 16.66 CPI    **
C               **  POINT SIZE - ESC (s<POINTSIZE>V                     **
C               **  CPI        - ESC (s<CPI>H                           **
C               **  REFERENCE--HP SERIES II LASER JET TECHNICAL         **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **********************************************************
C
 2600 CONTINUE
      ICSTR(1:1)=IESCC
      IF(IPCLFN.EQ.'COND')GOTO2610
C
C  COURIER MEDIUM, COURIER BOLD CASE
C
      ICSTR(2:6)='(s12V'
      ICSTR(7:7)=IESCC
      ICSTR(8:12)='(s10H'
      NCSTR=12
      GOTO2690
C
C  CONDENSED LINE PRINTER CASE
C
 2610 CONTINUE
      ICSTR(2:7)='(s8.5V'
      ICSTR(8:8)=IESCC
      ICSTR(9:16)='(s16.66H'
      NCSTR=16
      GOTO2690
C
 2690 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
CCCCC WRITE(IGUNIT,3111)PHEIGH,PWIDTH
C3111 FORMAT('SET SIZE CHARACTERS ',F10.5,2X,F10.5)
      ICSTR(1:20)='SET SIZE CHARACTERS '
      NCSTR=20
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(31:32)='  '
      NCSTR=32
      CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      ICSTR(1:5)='SESI '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3300 CONTINUE
      ICSTR(1:11)='CHARHEIGHT '
      NCSTR=10
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(22:22)=';'
      NCSTR=22
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO SET SIZE--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               **  USE CALCOMP LIBRARY.  SIZE SENT TO "SYMBOL"     **
C               **  SUBROUTINE IN "GRWRTH" AND "GRWRTV".            **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRSESI TO SET CHAR SZ CALCOMP DEVICE')
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(IQWNFT.LT.1)GOTO9000
      ICSTR=' '
CCCCC ICSTR(1:7)='t Arial'
CCCCC ICSTR(2:2)=IQUOTE
CCCCC NCSTR=8
CCCCC ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=1
      ICSTR(NCSTR:NCSTR)='f'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='h'
      NCSTR=NCSTR+1
      IF(JHEIG2.LE.5)JHEIG2=5
      IF(JHEIG2.GE.30)JHEIG2=30
      WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JHEIG2
      NCSTR=NCSTR+2
      ICSTR(NCSTR:NCSTR)='w'
      NCSTR=NCSTR+1
      IF(JWIDT2.LE.5)JWIDT2=5
      IF(JWIDT2.GE.30)JWIDT2=30
      WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JWIDT2
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='b'
CQWVF IRESLT=SETFONT(ICSTR(1:NCSTR))
CCCCC IRESLT=SETFONT('n1')
CQWVF IRESLT=GETFONTINFO(MSFONT)
CQWVF JHEIG2=MSFONT.PIXHEIGHT
CQWVF JWIDT2=MSFONT.PIXWIDTH
      IF(JHEIG2.EQ.0)JHEIG2=16
      IF(JWIDT2.EQ.0)JWDT2=8
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
CINTE CALL IGrCharSize(PHEIG2,PWIDT2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      ATEMP=1.5
      AHEIG=PHEIG2/(100.0*(1.0/25.0))
      AWIDTH=PWIDT2/(ATEMP*100.0*(1.0/75.0))
CWINT CALL IGrCharSize(AHEIG,AWIDTH)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO SET SIZE--                                   **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE ZETA VERSION OF CALCOMP LIBRARY.  SIZE      **
C               **  SENT TO "SYMBOL" ROUTINE IN "GRWRTH" AND "GRWRTV"**
C               **  HOWEVER, SET THE CHARACTER ASPECT RATIO IN GRTRSI*
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO SET SIZE--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRSESI TO SIZE CHAR SZ RAMTEK DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSESI TO SET CHAR SZ RAMTEK DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
 6600 CONTINUE
      IDUMMY  = INT(PHEIG2*100)
CSUN  CALL cfcharheight(IDUMMY)
      GOTO 9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO SET SIZE--                                   **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRSESI TO SIZE CHAR SZ XXXXXX DEVICE')
      ICSTR(1:50)='FIX SUBROUTINE GRSESI TO SET CHAR SZ XXXXXX DEVICE'
      NCSTR=50
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO SET CHARACTER HEIGHT---                      **
C               **  WRITE OUT A  T ( S SIZE-NUMBER )                **
C               **  WHERE SIZE-NUMBER IS FROM 0 TO 16               **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 118                            **
C               ******************************************************
C
C MARCH, 1991.  BASE ON VALUE OF JSIZE (DETERMINED IN GRTRSI).
 8100 CONTINUE
      ICSTR(1:3)='T(S'
      ICSTR(4:6)=' 0)'
CCCCC IF(PHEIG2.GT.03.1)ICSTR(4:6)='01)'
CCCCC IF(PHEIG2.LE.05.2)GOTO8110
CCCCC IF(PHEIG2.GT.05.2)ICSTR(4:6)='02)'
CCCCC IF(PHEIG2.GT.07.8)ICSTR(4:6)='03)'
CCCCC IF(PHEIG2.GT.10.9)ICSTR(4:6)='04)'
CCCCC IF(PHEIG2.GT.14.1)ICSTR(4:6)='05)'
CCCCC IF(PHEIG2.GT.17.2)ICSTR(4:6)='06)'
CCCCC IF(PHEIG2.GT.20.3)ICSTR(4:6)='07)'
CCCCC IF(PHEIG2.GT.23.4)ICSTR(4:6)='08)'
CCCCC IF(PHEIG2.GT.26.6)ICSTR(4:6)='09)'
CCCCC IF(PHEIG2.GT.29.7)ICSTR(4:6)='10)'
CCCCC IF(PHEIG2.GT.32.8)ICSTR(4:6)='11)'
CCCCC IF(PHEIG2.GT.35.9)ICSTR(4:6)='12)'
CCCCC IF(PHEIG2.GT.39.1)ICSTR(4:6)='13)'
CCCCC IF(PHEIG2.GT.42.2)ICSTR(4:6)='14)'
CCCCC IF(PHEIG2.GT.45.3)ICSTR(4:6)='15)'
CCCCC IF(PHEIG2.GT.48.4)ICSTR(4:6)='16)'
      IF(JSIZE.GE.0.AND.JSIZE.LE.9)WRITE(ICSTR(5:5),'(I1)')JSIZE
      IF(JSIZE.GE.10.AND.JSIZE.LE.99)WRITE(ICSTR(4:5),'(I2)')JSIZE
 8110 CONTINUE
      NCSTR=6
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  CHARACTER SIZE DETERMINED BY POINT SIZE         **
C               **  OF FONT SELECTED.  FONT SELECTED IN "GRWRTH"    **
C               **  "GRWRTV".  NOTHING DONE HERE.                   **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **             COOKBOOK, ADOBE SYSTEMS              **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  CHARACTER SIZE DETERMINED BY POINT SIZE         **
C               **  OF FONT SELECTED.  FONT SELECTED IN "GRWRTH"    **
C               **  "GRWRTV".  NOTHING DONE HERE.                   **
C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
C               **             FROM QMS                             **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  C LIBRARY WILL HANDLE SIZE AND JUSTIFICATION,   **
C               **  SO THIS WILL BE  A NULL ROUTINE                 **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
C               *************************************************
C
10000 CONTINUE
      CALL TCSESI(PHEIGH,PWIDTH,PVEGAP,PHOGAP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
CAQUA CALL aqtSetFontsize(PHEIG2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX                  DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      IF(JSIZE.EQ.1)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:5)='tiny'
        NCSTR=5
      ELSEIF(JSIZE.EQ.2)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:11)='scriptsize'
        NCSTR=11
      ELSEIF(JSIZE.EQ.3)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:13)='footnotesize'
        NCSTR=13
      ELSEIF(JSIZE.EQ.5)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:6)='small'
        NCSTR=6
      ELSEIF(JSIZE.EQ.5)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:11)='normalsize'
        NCSTR=11
      ELSEIF(JSIZE.EQ.6)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:6)='large'
        NCSTR=6
      ELSEIF(JSIZE.EQ.7)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:6)='Large'
        NCSTR=6
      ELSEIF(JSIZE.EQ.8)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:6)='LARGE'
        NCSTR=6
      ELSEIF(JSIZE.EQ.9)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:5)='huge'
        NCSTR=5
      ELSEIF(JSIZE.EQ.10)THEN
        ICSTR(1:1)=IBASLC
        ICSTR(2:5)='Huge'
        NCSTR=5
      ELSE
        ICSTR(1:1)=IBASLC
        ICSTR(2:11)='normalsize'
        NCSTR=11
      ENDIF
C
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SESI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSESI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE,IFONT
 9012 FORMAT('ICASE,IFONT = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9013 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)JSIZE
 9014 FORMAT('JSIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)JHEIG2,JWIDT2,JVEGA2,JHOGA2
 9015 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9016 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IMANUF,IMODEL
 9017 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)PVETO2,PHOTO2,IX,IY
 9018 FORMAT('PVETO2,PHOTO2,IX,IY = ',2E15.7,2X,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRSETH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              SET A THICKNESS (E.G., A PEN THICKNESS)
C              ON A SPECIFIC GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD STYLE CALCOMP
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. SUPPORT FOR LATEX
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XLATTR
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='SETH'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SETH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRSETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PTHICK
   53 FORMAT('PTHICK = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
C               **  LINE THICKNESS IMPLEMENTED IN SOFTWARE          **
C               ******************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **  LASERJET LASER PRINTERS                             **
C               **********************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
C  JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS.
C  SET THICKNESS <ON/OFF> - IF OFF, LINE WIDTH IS SET TO THE
C                           REQUESTED VALUE, UP TO THE POST PROCESSOR
C                           TO IMPLEMENT MULTIPLE WIDTH LINES.
C                           IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED
C                           WITHIN DATAPLOT.  THE LINE WIDTH FOR A
C                           SINGLE LINE DETERMINED BY NEXT COMMAND.
C  SET PEN WIDTH <WIDTH> - SETS PEN WIDTH TO BE USED IN IMPLEMENTING
C                          MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT)
 3100 CONTINUE
C
      IF(IPTHSW.EQ.'ON')GOTO3150
C
      ICSTR(1:14)='SET THICKNESS '
      NCSTR=14
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3190
C
 3150 CONTINUE
C
      ICSTR(1:14)='SET THICKNESS '
      NCSTR=14
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3190 CONTINUE
C
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS.
C  SET THICKNESS <ON/OFF> - IF OFF, LINE WIDTH IS SET TO THE
C                           REQUESTED VALUE, UP TO THE POST PROCESSOR
C                           TO IMPLEMENT MULTIPLE WIDTH LINES.
C                           IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED
C                           WITHIN DATAPLOT.  THE LINE WIDTH FOR A
C                           SINGLE LINE DETERMINED BY NEXT COMMAND.
C  SET PEN WIDTH <WIDTH> - SETS PEN WIDTH TO BE USED IN IMPLEMENTING
C                          MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT)
 3200 CONTINUE
C
      IF(IPTHSW.EQ.'ON')GOTO3250
C
      ICSTR(1:5)='SETH '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3290
C
 3250 CONTINUE
C
      ICSTR(1:5)='SETH '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3290 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM            CASE                   **
C               **  LINEWIDTH <NUMBER>                              **
C               **  NOTE THAT LINE WIDTH SPECIFICATION MODE IS SET  **
C               **  TO ABSOLUTE IN "GRINDE".  THIS CORRESPONDS TO   **
C               **  THE DATAPLOT MEANING (I.E., 0.1 IS A PERCENTAGE **
C               **  OF THE TOTAL (100 PER CENT) VERTICAL SIZE OR    **
C               **  VDC UNITS.                                      **
C               **  NOTE: THE ABSOLUTE MODE DESCRIBED IN THE STANDARD*
C               **        DOES NOT SEEM TO BE SUPPORTED.  THERE IS  **
C               **        AN "ABSTRACT" MODE, BUT I CAN NOT FIND    **
C               **        DOCUMENTATION ON WHAT THIS MEANS.  IT MAY **
C               **        BE A REPLACEMENT FOR ABSOLUTE, BUT I AM   **
C               **        NOT SURE.  FOR NOW, USE SCALED MODE WHICH **
C               **        SPECIFIES LINE WIDTH AS A MULTIPLE OF THE **
C               **        NOMINAL DEVICE LINE WIDTH.                **
C               ******************************************************
C
 3300 CONTINUE
C
      IF(IPTHSW.EQ.'ON')GOTO3350
C
      ICSTR(1:10)='LINEWIDTH '
      NCSTR=10
      ASCALE=PTHIC2/PPENSW
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(ASCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(21:21)=';'
      NCSTR=21
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3390
C
 3350 CONTINUE
C
      ICSTR(1:14)='LINEWIDTH 1.0;'
      NCSTR=14
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3390 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  LINE THICKNESS IS IMPLEMENTED IN SOFTWARE       **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IOPGOF.EQ.'OFF')GOTO9000
      ICODE=1
      ISTYLE=0
      CALL GLATTR(ICODE,ISTYLE,PTHIC2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN           CASE                    **
C               ******************************************************
C
 6600 CONTINUE
CSUN  CALL cflnwidth(pthick)
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS         CASE                    **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT    CASE                    **
C               **  <NUMBER> SETLINEWIDTH                           **
C               ******************************************************
C
 8600 CONTINUE
      NCHTOT=5
      NCSTR=0
      ITEMP=INT(PTHIC2)
      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
      ICSTR(6:18)=' setlinewidth'
      NCSTR=18
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC          CASE                    **
C               **  FOR QUIC, THE PEN WIDTH IS SET ONLY AFTER       **
C               **  VECTOR GRAPHICS MODE IS ENTERED IN "GRDRLI" OR  **
C               **  "GRDRPL".  NOTHING DONE HERE                    **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11           CASE                    **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9000
      ICODE=1
      INDEX=PTHIC2+0.5
      CALL XLATTR(INDEX,ICODE)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 124.         **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 320-321.                   **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 30.         **
C               *************************************************
C
10000 CONTINUE
      CALL TCSETH(PTHICK)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  LINE THICKNESS HANDLED IN SOFTWARE              **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
CAQUA CALL aqtSetLinewidth(PTHIC2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      IF(ILATLT.EQ.'HARD')THEN
        IF(PTHIC2.GE.0.25)THEN
          ICSTR(1:1)=IBASLC
          ICSTR(2:11)='Thicklines'
          NCSTR=11
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSEIF(PTHIC2.GE.0.15)THEN
          ICSTR(1:1)=IBASLC
          ICSTR(2:11)='thicklines'
          NCSTR=11
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ELSE
          ICSTR(1:1)=IBASLC
          ICSTR(2:10)='thinlines'
          NCSTR=10
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SETH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRSETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PTHICK,JTHICK,PTHIC2
 9013 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRCA(ITYPE,ICASE,JCASE)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A CASE (UPPER OR LOWER) GIVEN IN CHARACTER REPRESENTATI
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ITYPE
      CHARACTER*4 ICASE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRCA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ITYPE
   52 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASE
   53 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 0--                       **
C               **  DEFINE CASE                    **
C               **  FOR A GENERAL GRAPHICS DEVICE  **
C               *************************************
C
      JCASE=1
      IF(ICASE.EQ.'UPPE')JCASE=1
      IF(ICASE.EQ.'LOWE')JCASE=2
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HP-2622   CASE                        **
C               ******************************************************
C
 2300 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM       CASE                        **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRCA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ITYPE
 9012 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASE,JCASE
 9013 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRCO(ICASE,ICOL,JCOL)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A COLOR GIVEN IN CHARACTER REPRESENTATION
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C     NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1990. PEN MAP FOR HPGL, ZETA, CALCOMP (ALAN)
C     UPDATED         --JULY     1990. SOME HP-26XX TERMINALS SUPPORT COLOR
C     UPDATED         --AUGUST   1990. SUPPORT GRAYSCALE ON POSTSCRIPT (ALAN)
C     UPDATED         --JANUARY  1991. ADD COLOR SUPPORT FOR REGIS (ALAN)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JUNE     1991. ADDITIONAL COLOR SUPPORT FOR X11 (ALAN)
C     UPDATED         --AUGUST   1992. SIGNIFICANT CHANGES TO SUPPORT A
C                                      CONSISTENT SET OF COLORS AND
C                                      INDICES (ALAN)
C                                      ALSO MAKE TABLE-DRIVEN FOR
C                                      BETTER EFFICIENCY.
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 ICOL
C  FOLLOWING LINE  ADDED AUGUST, 1990.
CCCCC CHARACTER*4 ICOLT
C  FOLLOWING ADDED AUGUST 1992.
      CHARACTER*4 CJUNK
C
      PARAMETER (MAXCLR=89)
C
      CHARACTER*4 ICOLNM(MAXCLR)
C
      INTEGER J4027(MAXCLR)
      INTEGER J4105(MAXCLR)
      INTEGER JPLOT4(MAXCLR)
      INTEGER JPLOT8(MAXCLR)
      INTEGER J2622(MAXCLR)
      INTEGER JCGM(MAXCLR)
      INTEGER JSUN(MAXCLR)
      INTEGER JX11(MAXCLR)
      INTEGER JREGIS(MAXCLR)
      INTEGER JPC(MAXCLR)
      INTEGER JLAHEY(MAXCLR)
      INTEGER JWINT(MAXCLR)
C
      CHARACTER*130 ICSTR
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C  AUGUST 1992.  DEFINE COLOR TABLES.
C
C  ROW 1: WHIT, BLAC, RED , BLUE, GREE, MAGE, ORAN, CYAN, YELL, YGRE
C  ROW 2: DGRE, LBLU, VBLU, VRED, DGRA, LGRA, AQUA, BROW, CABL, CORA
C  ROW 3: CBLU, DOGR, DORC, DSBL, DTUR, FIRE, FGRE, GOLD, GLDR, GRAY
C  ROW 4: IRED, KHAK, DMGR, LSBL, LGRE, MARO, MAQU, MBLU, MFGR, MGLD
C  ROW 5: MORC, MSGR, MSBL, MSPG, MTUR, MVRD, MDBL, NAVY, ORED, ORCH
C  ROW 6: PGRE, PINK, PLUM, PURP, SALM, SGRE, SIEN, SKBL, SBLU, SPGR
C  ROW 7: STBL, TAN , THIS, TURQ, VIOL, WHEA, GYEL, LCYA, BLU2, BLU3
C  ROW 8: BLU4, CYA2, CYA3, CYA4, GRE2, GRE3, GRE4, YEL2, YEL3, YEL4
C  ROW 9: ORA2, ORA3, ORA4, RED2, RED3, RED4, MAG1, MAG2, MAG3
C
      DATA (ICOLNM(I),I=1,50)/
     1 'WHIT', 'BLAC', 'RED ', 'BLUE', 'GREE', 'MAGE', 'ORAN', 'CYAN',
     X 'YELL', 'YGRE',
     2 'DGRE', 'LBLU', 'VBLU', 'VRED', 'DGRA', 'LGRA', 'AQUA', 'BROW',
     X 'CABL', 'CORA',
     3 'CBLU', 'DOGR', 'DORC', 'DSBL', 'DTUR', 'FIRE', 'FGRE', 'GOLD',
     X 'GLDR', 'GRAY',
     4 'IRED', 'KHAK', 'DMGR', 'LSBL', 'LGRE', 'MARO', 'MAQU', 'MBLU',
     X 'MFGR', 'MGLD',
     5 'MORC', 'MSGR', 'MSBL', 'MSPG', 'MTUR', 'MVRD', 'MDBL', 'NAVY',
     X 'ORED', 'ORCH'/
      DATA (ICOLNM(I),I=51,MAXCLR)/
     6 'PGRE', 'PINK', 'PLUM', 'PURP', 'SALM', 'SGRE', 'SIEN', 'SKBL',
     X 'SBLU', 'SPGR',
     7 'STBL', 'TAN ', 'THIS', 'TURQ', 'VIOL', 'WHEA', 'GYEL', 'LCYA',
     X 'BLU2', 'BLU3',
     8 'BLU4', 'CYA2', 'CYA3', 'CYA4', 'GRE2', 'GRE3', 'GRE4', 'YEL2',
     X 'YEL3', 'YEL4',
     9 'ORA2', 'ORA3', 'ORA4', 'RED2', 'RED3', 'RED4', 'MAG2', 'MAG3',
     X 'MAG4'/
C
C  TEKTRONIX 4027
C
C  WHITE   = 0
C  RED     = 1
C  GREEN   = 2
C  BLUE    = 3
C  YELLOW  = 4
C  ORANGE  = 5
C  PURPLE  = 6
C  BLACK   = 7
C
      DATA (J4027(I),I=1,MAXCLR)/
     1  0,  7,  1,  3,  2,  6,  5,  3,  4,  4,
     2  2,  3,  3,  1,  7,  0,  3,  5,  3,  1,
     3  3,  2,  6,  3,  6,  4,  2,  4,  4,  7,
     4  1,  4,  0,  3,  2,  1,  3,  3,  2,  4,
     5  6,  2,  3,  2,  6,  6,  3,  3,  5,  6,
     6  2,  1,  6,  6,  4,  2,  6,  3,  3,  2,
     7  3,  4,  4,  6,  6,  4,  2,  3,  3,  3,
     8  3,  3,  3,  3,  2,  2,  2,  4,  4,  4,
     9  5,  5,  5,  1,  1,  1,  6,  6,  6/
C  TEKTRONIX 4105, GENERAL, GENERAL CODED
C
C  BLACK  = 0
C  WHITE  = 1
C  RED    = 2
C  GREEN  = 3
C  BLUE   = 4
C  CYAN   = 5
C  MAGENTA= 6
C  YELLOW = 7
C
      DATA (J4105(I),I=1,MAXCLR)/
     1  1,  0,  2,  4,  3,  6,  2,  5,  7,  7,
     2  3,  4,  4,  2,  0,  1,  4,  2,  4,  2,
     3  4,  3,  6,  4,  6,  7,  3,  7,  7,  0,
     4  2,  7,  1,  4,  3,  2,  4,  4,  3,  7,
     5  6,  3,  4,  3,  6,  6,  4,  4,  2,  6,
     6  3,  2,  6,  6,  7,  3,  6,  4,  4,  3,
     7  4,  7,  7,  6,  6,  7,  3,  5,  4,  4,
     8  4,  5,  5,  5,  3,  3,  3,  7,  7,  7,
     9  7,  7,  7,  2,  2,  2,  6,  6,  6/
C
C  PLOTTERS WITH 4 PENS (TEKTRONIX 4662, HP-7221, CALCOMP, ZETA, HP-GL)
C
C  BLACK   = 1
C  RED     = 2
C  BLUE    = 3
C  GREEN   = 4
C
      DATA (JPLOT4(I),I=1,MAXCLR)/
     1  1,  1,  2,  3,  4,  4,  2,  3,  2,  2,
     2  4,  3,  3,  2,  1,  1,  3,  2,  3,  2,
     3  3,  4,  2,  3,  2,  2,  4,  2,  2,  1,
     4  2,  2,  1,  3,  4,  2,  3,  3,  4,  2,
     5  2,  4,  3,  4,  2,  2,  3,  3,  2,  2,
     6  4,  2,  2,  2,  2,  4,  2,  3,  3,  4,
     7  3,  2,  2,  2,  2,  2,  4,  3,  3,  3,
     8  3,  3,  3,  3,  4,  4,  4,  2,  2,  2,
     9  2,  2,  2,  2,  2,  2,  4,  4,  4/
C
C  PLOTTERS WITH 8 PENS (HP-GL, CALCOMP, ZETA)
C
C  BLACK   = 1
C  RED     = 2
C  BLUE    = 3
C  GREEN   = 4
C  MAGENTA = 5
C  ORANGE  = 6
C  CYAN    = 7
C  YELLOW  = 8
C
      DATA (JPLOT8(I),I=1,MAXCLR)/
     1  1,  1,  2,  3,  4,  5,  6,  7,  8,  8,
     2  4,  7,  3,  2,  1,  1,  3,  8,  3,  2,
     3  3,  4,  5,  3,  5,  8,  4,  8,  8,  1,
     4  2,  8,  1,  3,  4,  5,  7,  3,  4,  8,
     5  5,  4,  7,  4,  5,  5,  3,  3,  6,  5,
     6  4,  2,  5,  5,  8,  4,  5,  7,  3,  4,
     7  3,  8,  8,  5,  5,  8,  4,  7,  3,  3,
     8  3,  7,  7,  7,  4,  4,  4,  8,  8,  8,
     9  6,  6,  6,  2,  2,  2,  5,  5,  5/
C
C  HP-2622 AND RELATED TERMINALS
C
C  BLACK   = 0
C  RED     = 1
C  GREEN   = 2
C  YELLOW  = 3
C  BLUE    = 4
C  MAGENTA = 5
C  CYAN    = 6
C  WHITE   = 7
C
      DATA (J2622(I),I=1,MAXCLR)/
     1  7,  0,  1,  4,  2,  5,  3,  6,  3,  3,
     2  2,  6,  4,  1,  0,  7,  6,  3,  4,  1,
     3  4,  2,  5,  4,  5,  3,  2,  3,  3,  0,
     4  1,  3,  7,  6,  2,  5,  6,  4,  2,  3,
     5  5,  2,  6,  2,  5,  5,  4,  4,  3,  5,
     6  2,  1,  5,  5,  3,  2,  5,  6,  4,  2,
     7  4,  3,  3,  5,  5,  3,  2,  6,  4,  4,
     8  4,  6,  6,  6,  2,  2,  2,  3,  3,  3,
     9  3,  3,  3,  1,  1,  1,  5,  5,  5/
C
C  DIRECT RGB DEVICES (CGM, POSTSCRIPT)
C
C  THESE DEVICES ALLOW THE RGB VALUE TO BE SPECIFIED DIRECTLY,
C  SO SIMPLY MAP TO SAME INDEX.  GRSECO ROUTINE WILL THEN USE
C  A TABLE OF RGB VALUES.
C
      DATA (JCGM(I),I=1,MAXCLR)/
     1  1,  2,  3,  4,  5,  6,  7,  8,  9, 10,
     2 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
     3 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
     4 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
     5 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
     6 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
     7 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
     8 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
     9 81, 82, 83, 84, 85, 86, 87, 88, 89/
C
C  SUN
C
C  RED     = 1
C  GREEN   = 2
C  BLUE    = 3
C  YELLOW  = 4
C  BLACK   = 5
C  MAGENTA = 6
C  WHITE   = 7
C  DARK    = 0  (ONLY MAP DARK GRAY TO THIS, OTHERWISE USE BLACK)
C
      DATA (JSUN(I),I=1,MAXCLR)/
     1  7,  5,  1,  3,  2,  6,  4,  3,  4,  4,
     2  2,  3,  3,  1,  0,  7,  3,  4,  3,  1,
     3  3,  2,  6,  3,  6,  4,  2,  4,  4,  0,
     4  1,  4,  7,  3,  2,  6,  3,  3,  2,  4,
     5  6,  2,  3,  2,  6,  6,  3,  3,  1,  6,
     6  2,  1,  6,  6,  4,  2,  6,  3,  3,  2,
     7  3,  4,  4,  6,  6,  4,  2,  3,  3,  3,
     8  3,  3,  3,  3,  2,  2,  2,  4,  4,  4,
     9  4,  4,  4,  1,  1,  1,  6,  6,  6/
C
C  X11
C
C  SUPPORTS FULL SET OF COLORS
C
      DATA (JX11(I),I=1,MAXCLR)/
     1  1,  0,  4,  5,  2,  6,  8,  7,  3,  9,
     2 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
     3 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
     4 30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
     5 40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
     6 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
     7 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
     8 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
     9 80, 81, 82, 83, 84, 85, 86, 87, 88/
C
C  REGIS
C
C  SUPPORTS FULL SET OF COLORS (WITH 1 OR 2 OMISSIONS)
C
      DATA (JREGIS(I),I=1,MAXCLR)/
     1 62,  3, 47,  4, 23, 39, 41, 18, 63, 64,
     2 24,  8, 60, 51, 35, 37,  1,  3,  5, 17,
     3  6, 25, 43,  7, 57, 19, 26, 20, 21, 35,
     4 48, 38, 36,  9, 27, 40,  2, 10, 28, 22,
     5 44, 29, 11, 30, 58, 49, 12, 13, 50, 42,
     6 31, 45, 46, 57, 52, 32, 53, 14, 15, 33,
     7 16, 54, 55, 56, 59, 61, 34, 18,  4,  4,
     8  4, 18, 18, 18, 23, 23, 23, 63, 63, 63,
     9 41, 41, 41, 47, 47, 47, 39, 39, 39/
C
C  IBM-PC (TURBO-C DRIVER)
C
C  BLACK   = 0
C  BLUE    = 1
C  GREEN   = 2
C  CYAN    = 3
C  RED     = 4
C  MAGENTA = 5
C  BROWN   = 6
C  GRAY    = 7
C  DGRA    = 8
C  LBLUE   = 9
C  LGRAY   =10
C  LCYAN   =11
C  LRED    =12
C  LMAGE   =13
C  YELLOW  =14
C  WHITE   =15
C
C  LRED,  LMAGE ARE NOT IN THE SUPPORTED COLOR LIST.
C  LRED MAPS TO RED2
C  LMAG MAPS TO MAG2
C
      DATA (JPC(I),I=1,MAXCLR)/
     1 15,  0,  4,  1,  2,  5, 14,  3, 14, 14,
     2  2,  9,  1,  4,  8, 10,  3,  6,  9, 12,
     3  1,  2,  5,  1,  5, 14,  2, 14, 14,  7,
     4 12, 14, 10,  9,  2,  5, 11,  9,  2, 14,
     5  5,  2,  9,  2, 13,  5,  1,  1,  4, 13,
     6  2,  4,  5,  5, 14,  2,  5, 11,  1,  2,
     7  1,  6, 14,  5,  5, 14,  2, 11,  1,  1,
     8  1,  3,  3,  3,  2,  2,  2, 14, 14, 14,
     9 14, 14, 14,  4,  4,  4,  5,  5,  5/
C
C  IBM-PC  (LAHEY DRIVER)
C
C  BLACK   = 0
C  BLUE    = 1
C  GREEN   = 2
C  CYAN    = 3
C  RED     = 4
C  MAGENTA = 5
C  BROWN   = 6
C  GRAY    = 7
C  DGRA    = 8
C  LBLUE   = 9
C  LGRAY   =10
C  LCYAN   =11
C  LRED    =12
C  LMAGE   =13
C  YELLOW  =14
C  WHITE   =15
C
C  LRED,  LMAGE ARE NOT IN THE SUPPORTED COLOR LIST.
C  LRED MAPS TO RED2
C  LMAG MAPS TO MAG2
C
      DATA (JLAHEY(I),I=1,MAXCLR)/
     1 15,  0,  4,  1,  2,  5, 14,  3, 14, 14,
     2  2,  9,  1,  4,  8, 10,  3,  6,  9, 12,
     3  1,  2,  5,  1,  5, 14,  2, 14, 14,  7,
     4 12, 14, 10,  9,  2,  5, 11,  9,  2, 14,
     5  5,  2,  9,  2, 13,  5,  1,  1,  4, 13,
     6  2,  4,  5,  5, 14,  2,  5, 11,  1,  2,
     7  1,  6, 14,  5,  5, 14,  2, 11,  1,  1,
     8  1,  3,  3,  3,  2,  2,  2, 14, 14, 14,
     9 14, 14, 14,  4,  4,  4,  5,  5,  5/
C
C  IBM-PC  (LAHEY DRIVER, USING INTERACTOR OR WINTERACTOR)
C          THIS DRIVER SUPPORTS 16 COLORS, WITH EACH COLOR
C          SUPPORTING 16 SHADES.
C
C  WHITE         = 0 - 15
C  LIGHT RED     = 16 - 31
C  DARK  RED     = 32 - 47
C  LIGHT YELLOW  = 48 - 63
C  DARK  YELLOW  = 64 - 79
C  LIGHT GREEN   = 80 - 95
C  DARK  GREEN   = 96 - 111
C  LIGHT CYAN    = 112 - 127
C  DARK  CYAN    = 128 - 143
C  LIGHT BLUE    = 144 - 159
C  DARK  BLUE    = 160 - 175
C  LIGHT MAGENTA = 176 - 191
C  DARK  MAGENTA = 192 - 207
C  BLACK         = 208 - 223
C  DARK  GRAY    = 224 - 239
C  LIGHT GRAY    = 240 - 255
C
      DATA (JWINT(I),I=1,MAXCLR)/
     1  0,223, 47,175,111,207, 31,143, 79, 80,
     2111,144,207, 47,224,240, 80,223,160, 16,
     3144,111,207,175, 96, 64, 95, 64, 64, 224,
     4 32, 16,240,144, 80,192, 96,159, 96, 48,
     5 32, 96,160, 96,192,192,143,128, 32, 32,
     6 80, 16,176,207, 31, 95,127,159,160, 95,
     7160, 16, 48,176,207, 63, 64,112,164,168,
     8172,132,136,140,100,104,108, 68, 72, 76,
     9 20, 24, 28, 36, 40, 44,196,200,204/
C
C-----START POINT-----------------------------------------------------
C
C  AUGUST 1992.  BE CONSISTENT IN COLORS RECOGNIZED AND IN MAPPING
C  INDEX TO COLOR.  EXCEPTION IS THAT PEN PLOTTERS WILL STILL TREAT
C  INDEX AS A SLOT NUMBER (SINCE SLOT NUMBERS MAY BE FILLED WITH AN
C  ARBITRARY COLOR).
C
C     *****************************************************************
C     **  DATAPLOT SUPPORTS THE FOLLOWING COLORS.  THE TABLE SHOWS   **
C     **  THE DATAPLOT 4 CHARACTER NAME AND ASSOCIATED INDEX NUMBER. **
C     **  THE SUPPORTED COLORS ARE THE "NAMED" COLORS IN THE COLOR   **
C     **  DATABASE IN RELEASE 3 OF X11.  A FEW ADDITIONS ARE ADDED   **
C     **  FROM RELEASE 4 OF X11 (BUT NOT THE ENTIRE SET).  THE SOURCE**
C     **  IS APPENDIX D OF THE XLIB PROGRAMMERS REFERENCE (VOL. II)  **
C     **  FROM O'REILLY AND ASSOCIATES.  EVEN THOUGH WE ARE USING    **
C     **  THE RELEASE 3 LIST, USE THE RGB VALUES FROM RELEASE SINCE  **
C     **  RELEASE 3 WAS TUNED SPECIFICALLY TO A VT-240 WHILE RELEASE **
C     **  4 VALUES SHOULD BE A LITTLE MORE ROBUST.  HOWEVER, THE     **
C     **  SAME RGB VALUES CAN PRODUCE DIFFERENT COLORS ON DIFFERENT  **
C     **  HARDWARE.                                                  **
C     **                                                             **
C     **  X11 SUPPORTS THE FULL SET OF COLORS (SOME IMPLEMENTATIONS  **
C     **      MAY NOT, UNSUPPORTED COLORS MAPPED TO BLACK/WHITE).    **
C     **  POSTSCRIPT ALLOWS RGB VALUES TO BE SPECIFIED DIRECTLY.     **
C     **  CGM ALLOWS A COLOR TABLE TO BE DEFINED.                    **
C     **  REGIS SUPPORTS 64 OF THE 67 COLORS FROM RELASE 3, NONE OF  **
C     **      THE ADDITIONS OF RELEASE 4.                            **
C     **  MOST OTHER TERMINALS AND PLOTTERS SUPPORT 4 TO 8 COLORS,   **
C     **      UNAVAILABLE COLORS ARE MAPPED TO THE (HOPEFULLY)       **
C     **      CLOSEST SUPPORTED COLOR.  PENPLOTTERS ASSUME PEN SLOTS **
C     **      CONTAIN THE FOLLOWING COLORS:                          **
C     **      4 PENS            8 PENS:                              **
C     **      ======            =======                              **
C     **      BLACK             BLACK                                **
C     **      RED               RED                                  **
C     **      BLUE              BLUE                                 **
C     **      GREEN             GREEN                                **
C     **                        MAGENTA                              **
C     **                        ORANGE                               **
C     **                        CYAN                                 **
C     **                        YELLOW                               **
C     **                                                             **
C     **   USE THE <HPGL/CALCOMP/ZETA> PEN MAP COMMANDS IF A DIFFERENT*
C     **   ORDER IS USED.                                            **
C     **                                                             **
C     **   THE FOLLOWING IS THE LIST OF CURRENLT RECOGNIZED COLORS.  **
C     **                                                             **
C     **  COLOR             INDEX     DATAPLOT NAME    RGB           **
C     **  =====             =====     =============    ===           **
C     **  WHITE               0       WHIT             255, 255, 255 **
C     **  BLACK               1       BLAC               0,   0,   0 **
C     **  RED                 2       RED              255,   0,   0 **
C     **  BLUE                3       BLUE               0,   0, 255 **
C     **  GREEN               4       GREE               0, 255,   0 **
C     **  MAGENTA             5       MAGE             255,   0, 255 **
C     **  ORANGE              6       ORAN             255, 165,   0 **
C     **  CYAN                7       CYAN               0, 255, 255 **
C     **  YELLOW              8       YELL             255, 255,   0 **
C     **  YELLOW GREEN        9       YGRE             154, 205,  50 **
C     **  DARK GREEN         10       DGRE               0, 100,   0 **
C     **  LIGHT BLUE         11       LBLU             173, 216, 230 **
C     **  BLUE VIOLET        12       VBLU             138,  43, 226 **
C     **  VIOLET RED         13       VRED             208,  32, 144 **
C     **  DARK SLATE GRAY    14       DGRE,DGRA,DGRY    47,  79,  79 **
C     **  LIGHT GRAY         15       LGRE,LGRA,LGRY   211, 211, 211 **
C     **  AQUAMARINE         16       AQUA             127, 255, 212 **
C     **  BROWN              17       BROWN            165,  42,  42 **
C     **  CADET BLUE         18       CABL              95, 158, 160 **
C     **  CORAL              19       CORA             255, 127,  80 **
C     **  CORNFLOWER BLUE    20       CBLU             100, 149, 237 **
C     **  DARK OLIVE GREEN   21       DOGR              85, 107,  47 **
C     **  DARK ORCHID        22       DORC             153,  50, 204 **
C     **  DARK SLATE BLUE    23       DSBL              72,  61, 139 **
C     **  DARK TURQUOISE     24       DTUR               0, 206, 209 **
C     **  FIREBRICK          25       FIRE             178,  34,  34 **
C     **  FOREST GREEN       26       FGRE              34, 139,  34 **
C     **  GOLD               27       GOLD             255, 215,   0 **
C     **  GOLDENROD          28       GLDR             218, 165,  32 **
C     **  GRAY               29       GRAY, GREY       192, 192, 192 **
C     **  INDIAN RED         30       IRED, LRED       205,  92,  92 **
C     **  KHAKI              31       KHAK             240, 230, 140 **
C     **  DIM GRAY           32       DMGR             105, 105, 105 **
C     **  LIGHT STEEL BLUE   33       LSBL             176, 196, 222 **
C     **  LIME GREEN         34       LGRE              50, 205,  50 **
C     **  MAROON             35       MARO             176,  48,  96 **
C     **  MEDIUM AQUAMARINE  36       MAQU             102, 205, 170 **
C     **  MEDIUM BLUE        37       MBLU               0,   0, 205 **
C     **  MEDIUM FOREST GREEN38       MFGR             107, 142,  35 **
C     **  LIGHT GOLDENROD YEL39       MGLD             250, 250, 210 **
C     **  MEDIUM ORCHID      40       MORC             186,  85, 211 **
C     **  MEDIUM SEA GREEN   41       MSGR              60, 179, 113 **
C     **  MEDIUM SLATE BLUE  42       MSBL             123, 104, 238 **
C     **  MEDIUM SPRING GREEN43       MSPG               0, 250, 154 **
C     **  MEDIUM TURQUOISE   44       MTUR, LMAG        72, 209, 204 **
C     **  MEDIUM VIOLET RED  45       MVRD             199,  21, 133 **
C     **  MIDNIGHT BLUE      46       MDBL              25,  25, 112 **
C     **  NAVY BLUE          47       NAVY               0,   0, 128 **
C     **  ORANGE RED         48       ORED             255,  69,   0 **
C     **  ORCHID             49       ORCH             218, 112, 214 **
C     **  PALE GREEN         50       PGRE             152, 251, 152 **
C     **  PINK               51       PINK             255, 192, 203 **
C     **  PLUM               52       PLUM             221, 160, 221 **
C     **  PURPLE             53       PURP             160,  32, 240 **
C     **  SALMON             54       SALM             250, 128, 114 **
C     **  SEA GREEN          55       SGRE              46, 139,  87 **
C     **  SIENNA             56       SIEN             160,  82,  45 **
C     **  SKY BLUE           57       SKBL, SKYB,      135, 206, 235 **
C     **  SLATE BLUE         58       SBLU             106,  90, 205 **
C     **  SPRING GREEN       59       SPGR               0, 255, 127 **
C     **  STEEL BLUE         60       STBL              70, 130, 180 **
C     **  TAN                61       TAN              210, 180, 140 **
C     **  THISTLE            62       THIS             216, 191, 216 **
C     **  TURQUOISE          63       TURQ              64, 224, 208 **
C     **  VIOLET             64       VIOL             238, 130, 238 **
C     **  WHEAT              65       WHEA             245, 222, 179 **
C     **  GREEN YELLOW       66       GYEL             173, 255,  47 **
C     **  LIGHT CYAN         67       LCYA             224, 255, 255 **
C     **  BLUE2              68       BLU2               0,   0, 238 **
C     **  BLUE3              69       BLU3               0,   0, 205 **
C     **  BLUE4              70       BLU4               0,   0, 139 **
C     **  CYAN2              71       CYA2               0, 238, 238 **
C     **  CYAN3              72       CYA3               0, 205, 205 **
C     **  CYAN4              73       CYA4               0, 139, 139 **
C     **  GREEN2             74       GRE2               0, 238,   0 **
C     **  GREEN3             75       GRE3               0, 205,   0 **
C     **  GREEN4             76       GRE4               0, 139,   0 **
C     **  YELLOW2            77       YEL2             238, 238,   0 **
C     **  YELLOW3            78       YEL3             205, 205,   0 **
C     **  YELLOW4            79       YEL4             139, 139,   0 **
C     **  ORANGE2            80       ORA2             238, 154,   0 **
C     **  ORANGE3            81       ORA3             205, 133,   0 **
C     **  ORANGE4            82       ORA4             139,  90,   0 **
C     **  RED2               83       RED2, LRED       238,   0,   0 **
C     **  RED3               84       RED3             205,   0,   0 **
C     **  RED2               85       RED4             139,   0,   0 **
C     **  MAGENTA2           86       MAG2, LMAG       238,   0, 238 **
C     **  MAGENTA3           87       MAG3             205,   0, 205 **
C     **  MAGENTA4           88       MAG4             139,   0, 139 **
C     **                                                             **
C     **  SUPPORT GRAY SCALE WITH FOLLOWING SCHEME:                  **
C     **  G0     = BLACK                                             **
C     **  G1-G99 = GRAY SCALE FROM BLACK TO WHITE                    **
C     **  G100   = WHITE                                             **
C     **  -1 THROUGH -100 WILL CORRESPOND TO G1 THROUGH G100         **
C     **  CURRENTLY, POSTSCRIPT, X11, AND CGM SUPPORT GRAY SCALE,    **
C     **  OTHER DEVICES WILL MAP TO BLACK OR WHITE                   **
C     *****************************************************************
C
C     **********************************************
C     **    MAP A COLOR NAME TO AN INDEX FOR THE  **
C     **    GENERIC CASE.                         **
C     **********************************************
C
      JINDEX=-999
C
C  CHECK FOR SUPPORTED NAMES
C
      DO40I=1,MAXCLR
        IF(ICOL.EQ.ICOLNM(I))THEN
          JINDEX=I-1
          GOTO49
        ENDIF
 40   CONTINUE
C
C  CHECK FOR SYNONYMS
C
      IF(ICOL.EQ.'DGRY' .OR. ICOL.EQ.'DGRE')THEN
        JINDEX=14
        ICOL='DGRE'
      ELSEIF(ICOL.EQ.'LGRY' .OR. ICOL.EQ.'LGRE')THEN
        JINDEX=15
        ICOL='LGRA'
      ELSEIF(ICOL.EQ.'GREY')THEN
        JINDEX=29
        ICOL='GRAY'
      ELSEIF(ICOL.EQ.'LRED')THEN
        JINDEX=83
        ICOL='IRED'
      ELSEIF(ICOL.EQ.'LMAG')THEN
        JINDEX=44
        ICOL='MTUR'
      ELSEIF(ICOL.EQ.'SKYB')THEN
        JINDEX=57
        ICOL='SKBL'
      ENDIF
 49   CONTINUE
C
C  CHECK FOR INDEX (0 THROUGH MAXCLR-1)
C
      CJUNK='    '
      DO1I=0,9
        WRITE(CJUNK(1:1),'(I1)')I
        IF(ICOL(1:4).EQ.CJUNK(1:4))THEN
          JINDEX=I
          GOTO9
        ENDIF
 1    CONTINUE
 9    CONTINUE
      CJUNK='    '
      DO11I=10,MAXCLR-1
        WRITE(CJUNK(1:2),'(I2)')I
        IF(ICOL(1:4).EQ.CJUNK(1:4))THEN
          JINDEX=I
          GOTO19
        ENDIF
 11   CONTINUE
 19   CONTINUE
C
C  CHECK FOR GREY SCALE (G0 - G100 OR -1 THROUGH -100)
C
      IF(ICOL.EQ.'G0')JINDEX=1
      IF(ICOL.EQ.'G100')JINDEX=0
      IF(ICOL.EQ.'-100')JINDEX=0
      IF(ICOL(1:1).EQ.'G'.OR.ICOL(1:1).EQ.'-')THEN
        CJUNK='    '
        DO21I=1,9
          WRITE(CJUNK(1:1),'(I1)')I
          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
            JINDEX=-I
            GOTO29
          ENDIF
 21     CONTINUE
 29     CONTINUE
        CJUNK='    '
        DO31I=10,99
          WRITE(CJUNK(1:2),'(I2)')I
          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
            JINDEX=-I
            GOTO39
           ENDIF
 31     CONTINUE
 39     CONTINUE
      ENDIF
C
      ISUBN0='TRCO'
C
      NCSTR=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
   52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IGUNIT,IGCODE
   53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
   54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGBAUD
   55 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ICASE
   62 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICOL
   63 FORMAT('ICOL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IMANUF,IMODEL
   64 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4
   69 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4027')GOTO1100
      IF(IMODEL.EQ.'4105')GOTO1200
      IF(IMODEL.EQ.'4107')GOTO1200
      IF(IMODEL.EQ.'4109')GOTO1200
      IF(IMODEL.EQ.'4115')GOTO1200
      IF(IMODEL.EQ.'4662')GOTO1300
C
      GOTO1200
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
C     IF(IMODEL.EQ.'COLO')GOTO6600
C     GOTO6700
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE 4027 CASE                             **
C               **  (COLOR DEVICE)                                  **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1100 CONTINUE
      JCOL=0
CCCCC IF(ICOL.EQ.'WHIT')JCOL=0
CCCCC IF(ICOL.EQ.'RED')JCOL=1
CCCCC IF(ICOL.EQ.'GREE')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'YELL')JCOL=4
CCCCC IF(ICOL.EQ.'ORAN')JCOL=5
CCCCC IF(ICOL.EQ.'PURP')JCOL=6
CCCCC IF(ICOL.EQ.'BLAC')JCOL=7
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
      IF(JINDEX.LT.0)JCOL=0
      IF(JINDEX.GE.0)JCOL=J4027(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  TREAT THE 4105 CASE                             **
C               **  (COLOR DEVICE)                                  **
C               **  REFERENCE--PROGRAMMER'S MANUAL, PAGE 5-50       **
C               ******************************************************
C
 1200 CONTINUE
      JCOL=0
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
CCCCC IF(ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'GREE')JCOL=3
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE')JCOL=6
CCCCC IF(ICOL.EQ.'YELL')JCOL=7
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
      IF(JINDEX.LT.0)JCOL=0
      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  TREAT THE 4662 CASE                             **
C               **  (PENPLOTTER)                                    **
C               **  REFERENCE--XXX                                  **
C               ******************************************************
C
 1300 CONTINUE
      JCOL=1
CCCCC IF(ICOL.EQ.'BLAC')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'GREE')JCOL=4
C
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JPLOT4(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 6 .                             **
C               ******************************************************
C
 2100 CONTINUE
      JCOL=1
CCCCC IF(ICOL.EQ.'BLAC')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'GREE')JCOL=4
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
C  UPDATED MAY, 1990 FOR "PEN MAP"
C
 2200 CONTINUE
C
      IF(IHPGPF.EQ.'ON')GOTO2210
C
      JCOL=1
CCCCC IF(ICOL.EQ.'BLAC')JCOL=1
CCCCC IF(ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'GREE')JCOL=4
CCCCC IF(ICOL.EQ.'MAGE')JCOL=5
CCCCC IF(ICOL.EQ.'ORAN')JCOL=6
CCCCC IF(ICOL.EQ.'CYAN')JCOL=7
CCCCC IF(ICOL.EQ.'YELL')JCOL=8
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
      IF(JCOL.GT.IHPGCL)JCOL=MOD(JCOL-1,IHPGCL)+1
      GOTO9000
C
 2210 CONTINUE
      JCOL=1
      DO2219I=1,16
      IF(ICOL(1:4).NE.IHPGPM(I)(1:4))GOTO2219
      JCOL=I
      GOTO2299
 2219 CONTINUE
C
      IF(ICOL.EQ.'0')JCOL=0
      IF(ICOL.EQ.'1')JCOL=1
      IF(ICOL.EQ.'2')JCOL=2
      IF(ICOL.EQ.'3')JCOL=3
      IF(ICOL.EQ.'4')JCOL=4
      IF(ICOL.EQ.'5')JCOL=5
      IF(ICOL.EQ.'6')JCOL=6
      IF(ICOL.EQ.'7')JCOL=7
      IF(ICOL.EQ.'8')JCOL=8
C
 2299 CONTINUE
      IF(JCOL.GT.IHPGCL)JCOL=1
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE XX-X, XXX.                          **
C               **********************************************************
C
 2300 CONTINUE
      JCOL=7
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
CCCCC IF(ICOL.EQ.'WHIT')JCOL=7
CCCCC IF(ICOL.EQ.'RED')JCOL=1
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'GREE')JCOL=2
CCCCC IF(ICOL.EQ.'MAGE')JCOL=5
CCCCC IF(ICOL.EQ.'PURP')JCOL=5
CCCCC IF(ICOL.EQ.'ORAN')JCOL=3
CCCCC IF(ICOL.EQ.'CYAN')JCOL=6
CCCCC IF(ICOL.EQ.'YELL')JCOL=3
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=7
      IF(JINDEX.GE.0)JCOL=J2622(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL  CASE (LASERJET PRINTERS)         **
C               **  BLACK AND WHITE DEVICE, HOWEVER CAN USE         **
C               **  "DOT DENSITY" TO SIMULATE COLOR                 **
C               **  USED FOR REGIONS THAT ARE SOLID FILLED          **
C               **  REFERENCE--LASERJET SERIES II TECHNICAL REFERENCE*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
C  DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE
      JCOL=0
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
CCCCC IF(ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'GREE')JCOL=3
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE')JCOL=6
CCCCC IF(ICOL.EQ.'YELL')JCOL=7
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
      IF(JINDEX.LT.0)JCOL=0
      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
C  DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE
      JCOL=0
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
CCCCC IF(ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'GREE')JCOL=3
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE')JCOL=6
CCCCC IF(ICOL.EQ.'YELL')JCOL=7
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
      IF(JINDEX.LT.0)JCOL=0
      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE     **
C               **  NOTE: INDEX 0 IS RESERVED FOR THE BACKGROUND    **
C               **        COLOR.                                    **
C               **  NOTE: CGM ALSO ALLOWS COLORS TO BE SPECIFED BY  **
C               **        RGB COMPONENT RATHER THAN BY AN INDEX.  A **
C               **        FUTURE ENHANCEMENT WOULD BE TO SPECIFY    **
C               **        COLORS IN THIS FORMAT (SO BLUE WOULD BE   **
C               **        AN ACTUAL BLUE RATHER THAN AN ARBITRARY   **
C               **        INDEX NUMBER).                            **
C               **  AUGUST 1992.  USE RGB VALUES                    **
C               ******************************************************
C
 3300 CONTINUE
      JCOL=2
CCCCC IF(ICOL.EQ.'BLAC')JCOL=1
CCCCC IF(ICOL.EQ.'WHIT')JCOL=8
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'GREE')JCOL=3
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE')JCOL=6
CCCCC IF(ICOL.EQ.'YELL')JCOL=7
C
CCCCC IF(ICOL.LE.'1')JCOL=1
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.GE.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=2
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  USE CALCOMP LIBRARY (ROUTINE NEWPEN SELECTS PEN)**
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. CALCOMP DEVICE')
CCCCC ICSTR(1:52)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. CALCOMP DEVICE'
CCCCC NCSTR=52
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  UPDATE MAY, 1990.
C  1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK, RED,
C     GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA LIBRARY)
C  2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE THAN 4
C  3) CHECK FOR USER DEFINED PEN MAPPING
C
      IF(ICALPF.EQ.'ON')GOTO4130
C
CCCCC IF(ICALCL.GT.4)GOTO4120
C
CCCCC JCOL=1
CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED'.OR.ICOL.EQ.'ORAN'.OR.ICOL.EQ.'YELL')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE'.OR.ICOL.EQ.'CYAN')JCOL=3
CCCCC IF(ICOL.EQ.'GREE'.OR.ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=4
C
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=1
CCCCC IF(ICOL.EQ.'6')JCOL=2
CCCCC IF(ICOL.EQ.'7')JCOL=3
CCCCC IF(ICOL.EQ.'8')JCOL=4
CCCCC GOTO4199
C
C4120 CONTINUE
      JCOL=1
CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'GREE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=6
CCCCC IF(ICOL.EQ.'YELL'.OR.ICOL.EQ.'ORAN')JCOL=7
C
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
      IF(JCOL.GT.ICALCL)JCOL=MOD(JCOL-1,ICALCL)+1
      GOTO4199
C
 4130 CONTINUE
      JCOL=1
      DO4139I=1,16
      IF(ICOL(1:4).NE.ICALPM(I)(1:4))GOTO4139
      JCOL=I
      GOTO4199
 4139 CONTINUE
C
      IF(ICOL.EQ.'0')JCOL=0
      IF(ICOL.EQ.'1')JCOL=1
      IF(ICOL.EQ.'2')JCOL=2
      IF(ICOL.EQ.'3')JCOL=3
      IF(ICOL.EQ.'4')JCOL=4
      IF(ICOL.EQ.'5')JCOL=5
      IF(ICOL.EQ.'6')JCOL=6
      IF(ICOL.EQ.'7')JCOL=7
      IF(ICOL.EQ.'8')JCOL=8
      GOTO4199
C
 4199 CONTINUE
      IF(JCOL.GT.ICALCL)JCOL=1
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(ILAHPF.EQ.'ON')GOTO4630
      JCOL=1
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JLAHEY(JINDEX+1)
      IF(JCOL.GT.ILAHNC)JCOL=MOD(JCOL-1,ILAHNC)+1
      GOTO4699
C
 4630 CONTINUE
      JCOL=1
      DO4639I=1,16
      IF(ICOL(1:4).NE.ILAHPM(I)(1:4))GOTO4639
      JCOL=I
      GOTO4699
 4639 CONTINUE
C
      IF(ICOL.EQ.'0')JCOL=0
      IF(ICOL.EQ.'1')JCOL=1
      IF(ICOL.EQ.'2')JCOL=2
      IF(ICOL.EQ.'3')JCOL=3
      IF(ICOL.EQ.'4')JCOL=4
      IF(ICOL.EQ.'5')JCOL=5
      IF(ICOL.EQ.'6')JCOL=6
      IF(ICOL.EQ.'7')JCOL=7
      IF(ICOL.EQ.'8')JCOL=8
      GOTO4699
C
 4699 CONTINUE
      IF(JCOL.GT.ILAHNC)JCOL=1
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(IQWNCL.EQ.'VGA')THEN
        JCOL=0
        IF(JINDEX.LT.0)JCOL=0
        IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
      ELSEIF(IQWNCL.EQ.'RGB')THEN
        JCOL=1
        IF(JINDEX.LT.0)JCOL=JINDEX
        IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      ELSE
        JCOL=0
        IF(JINDEX.LT.0)JCOL=0
        IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      JCOL=223
      IF(JINDEX.LT.0)THEN
        JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
        IF(JCOL.LT.224)JCOL=224
        IF(JCOL.GT.255)JCOL=255
      ENDIF
      IF(JINDEX.GE.0)JCOL=JWINT(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                 **
C               ******************************************************
C
 4950 CONTINUE
      IF(IWINCL.EQ.'VGA')THEN
        JCOL=223
        IF(JINDEX.LT.0)THEN
          JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
          IF(JCOL.LT.224)JCOL=224
          IF(JCOL.GT.255)JCOL=255
        ELSE
          JCOL=JWINT(JINDEX)
        ENDIF
      ELSEIF(IWINCL.EQ.'RGB')THEN
        JCOL=2
        IF(JINDEX.LT.0)JCOL=JINDEX
        IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      ELSE
        JCOL=223
        IF(JINDEX.LT.0)THEN
          JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
          IF(JCOL.LT.224)JCOL=224
          IF(JCOL.GT.255)JCOL=255
        ELSE
          JCOL=JWINT(JINDEX)
        ENDIF
      ENDIF
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE CALCOMP LIBRARY ROUTINES                    **
C               ******************************************************
C
C  UPDATE MAY, 1990.
C  1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK, RED,
C     GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA LIBRARY)
C  2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE THAN 4
C  3) CHECK FOR USER DEFINED PEN MAPPING
C
 5100 CONTINUE
CCCCC JCOL=71
CCCCC IF(ICOL.EQ.'BLAC')JCOL=71
CCCCC IF(ICOL.EQ.'RED')JCOL=72
CCCCC IF(ICOL.EQ.'BLUE')JCOL=73
CCCCC IF(ICOL.EQ.'GREE')JCOL=74
C
CCCCC IF(ICOL.EQ.'1')JCOL=71
CCCCC IF(ICOL.EQ.'2')JCOL=72
CCCCC IF(ICOL.EQ.'3')JCOL=73
CCCCC IF(ICOL.EQ.'4')JCOL=74
CCCCC IF(ICOL.EQ.'5')JCOL=75
CCCCC IF(ICOL.EQ.'6')JCOL=76
CCCCC IF(ICOL.EQ.'7')JCOL=77
CCCCC IF(ICOL.EQ.'8')JCOL=78
C
      IF(IZETPF.EQ.'ON')GOTO5130
C
CCCCC IF(IZETCL.GT.4)GOTO5120
C
CCCCC JCOL=1
CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED'.OR.ICOL.EQ.'ORAN'.OR.ICOL.EQ.'YELL')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE'.OR.ICOL.EQ.'CYAN')JCOL=3
CCCCC IF(ICOL.EQ.'GREE'.OR.ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=4
C
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=1
CCCCC IF(ICOL.EQ.'6')JCOL=2
CCCCC IF(ICOL.EQ.'7')JCOL=3
CCCCC IF(ICOL.EQ.'8')JCOL=4
CCCCC GOTO5199
C
C5120 CONTINUE
      JCOL=1
CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1
CCCCC IF(ICOL.EQ.'RED')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'GREE')JCOL=4
CCCCC IF(ICOL.EQ.'CYAN')JCOL=5
CCCCC IF(ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=6
CCCCC IF(ICOL.EQ.'YELL'.OR.ICOL.EQ.'ORAN')JCOL=7
C
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
      IF(JINDEX.LT.0)JCOL=1
      IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
      IF(JCOL.GT.IZETCL)JCOL=MOD(JCOL-1,IZETCL)+1
      GOTO5199
C
 5130 CONTINUE
      JCOL=1
      DO5139I=1,16
      IF(ICOL(1:4).NE.IZETPM(I)(1:4))GOTO5139
      JCOL=I
      GOTO5199
 5139 CONTINUE
C
      IF(ICOL.EQ.'0')JCOL=0
      IF(ICOL.EQ.'1')JCOL=1
      IF(ICOL.EQ.'2')JCOL=2
      IF(ICOL.EQ.'3')JCOL=3
      IF(ICOL.EQ.'4')JCOL=4
      IF(ICOL.EQ.'5')JCOL=5
      IF(ICOL.EQ.'6')JCOL=6
      IF(ICOL.EQ.'7')JCOL=7
      IF(ICOL.EQ.'8')JCOL=8
      GOTO5199
C
 5199 CONTINUE
      IF(JCOL.GT.IZETCL)JCOL=1
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. RAMTEK DEVICE')
      ICSTR(1:51)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. RAMTEK DEVICE'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - COLOR SUPPORTED            **
C               ******************************************************
C
 6600 CONTINUE
      IF(ISUNCL.LE.0) THEN
         JCOL=1
      ELSE
CCCCC IF(ICOL.EQ.'RED')JCOL=1
CCCCC IF(ICOL.EQ.'ORAN')JCOL=1
CCCCC IF(ICOL.EQ.'GREE')JCOL=2
CCCCC IF(ICOL.EQ.'BLUE')JCOL=3
CCCCC IF(ICOL.EQ.'CYAN')JCOL=3
CCCCC IF(ICOL.EQ.'YELL')JCOL=4
CCCCC IF(ICOL.EQ.'BLAC')JCOL=5
CCCCC IF(ICOL.EQ.'PURP')JCOL=6
CCCCC IF(ICOL.EQ.'MAGE')JCOL=6
CCCCC IF(ICOL.EQ.'WHIT')JCOL=7
CCCCC IF(ICOL.EQ.'DARK')JCOL=0
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
        JCOL=5
        IF(JINDEX.LT.0)JCOL=5
        IF(JINDEX.GE.0)JCOL=JSUN(JINDEX+1)
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. XXXXXX DEVICE')
C
      ICSTR(1:51)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. XXXXXX DEVICE'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               **  NON-COLOR DEVICE                                **
C               **  ADD COLOR SUPPORT FOR REGIS JANUARY, 1991.      **
C               **  NOTE THAT REGIS SUPPORTS COLOR IN TWO WAYS.     **
C               **  IT ALLOWS AN RGB COLOR SPECIFIED BY NAME.  THIS **
C               **  METHOD ALLOWS 8 DIFFERENT COLORS (BLACK, RED,   **
C               **  GREEN, BLUE, CYAN, YELLOW, MAGENTA, WHITE)  IT  **
C               **  ALSO ALLOWS COLORS TO BE SPECIFIED BY HUE,      **
C               **  LIGHTNESS, AND SATURATION VALUES.  THIS METHOD  **
C               **  ALLOWS 64 COLORS TO BE SPECIFIED.  WE WILL USE  **
C               **  THE HLS METHOD SINCE IT ALLOWS MORE COLOR (ALL  **
C               **  THE RGB COLORS HAVE A CORRESPONDING HLS SPEC).  **
C               **  UNFORTUNATELY, NOT ALL THE COLORS HAVE SIMPLE 4 **
C               **  CHARACTER CODES.  MOST COLORS WILL HAVE TO BE   **
C               **  SPECIFIED BY AN INDEX.  TO MAKE IT EASIER FOR   **
C               **  USERS, A "SHOW REGIS COLORS" COMMAND WAS ADDED. **
C               **  TRANSLATION TAKEN FROM 5-32 OF VT-240 MANUAL.   **
C               **  NOTE THAT MONOCHROME REGIS SUPPORTS 4 INTENSITY **
C               **  LEVELS (I.E., GREY SCALES).  WE HAVE NOT        **
C               **  IMPLEMENTED GREY-SCALE REGION FILLS AS IS DONE  **
C               **  WITH MONOCHROME POSTSCRIPT DEVICES.             **
C               ******************************************************
C
 8100 CONTINUE
      JCOL=3
      IF(IGCOLO.NE.'ON')GOTO9000
C
      IF(JINDEX.LT.0)JCOL=3
      IF(JINDEX.GE.0)JCOL=JREGIS(JINDEX+1)
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  BLACK AND WHITE DEVICE, HOWEVER CAN USE         **
C               **  "GREY SCALE" TO SIMULATE COLOR                  **
C               **  USED FOR REGIONS THAT ARE SOLID FILLED          **
C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
C               **  MODIFIED JANUARY, 1990 TO SUPPORT COLOR         **
C               ******************************************************
C
C  AUGUST, 1990.  SUPPORT FULL GRAY SCALE WITH THE FOLLOWING SCHEME.  IF
C  THE COLOR IS GIVEN AS A NEGATIVE INDEX FROM -1 TO -256 (I.E., -1, -2,
C  ... , -256), INTERPERT THE NUMBER AS AN EXPLICIT GRAY SCALE INDEX.
C  POSITIVE INDEX NUMBERS (0 TO 15) WILL SUPPORT SPECIFIC COLORS AND WILL
C  BE MAPPED TO EXPLICIT GRAY SCALES (NOT NECESSARILY SCALED BY NUMERIC VALUE)
C  ON MONOCHROME DEVICES.
C
C  AUGUST 1992.  ABOVE SCHEME NO LONGER APPLIES.  SUPPORT ALL 67 COLORS
C  VIA SPECIFIC RGB VALUES, GRAY SCALE SPECIFIED VIA G0 THROUGH G100
C  AS STATED IN BEGINING COMMENTS.  NO LONGER USE THE NEGATIVE VALUES
C  SCHEME.
C
 8600 CONTINUE
CCCCC JCOL=0
CCCCC FOLLOWING LINE COMMENTED OUT AUGUST, 1990. (B/W EMULATES COLOR
CCCCC ON REGION FILLS WITH GRAY SCALE).
CCCCC IF(IGCOLO.NE.'ON')GOTO9000
CCCCC IF(ICOL.EQ.'WHIT')JCOL=7
CCCCC IF(ICOL.EQ.'YELL')JCOL=3
CCCCC IF(ICOL.EQ.'ORAN')JCOL=8
CCCCC IF(ICOL.EQ.'CYAN')JCOL=6
CCCCC IF(ICOL.EQ.'GREE')JCOL=2
CCCCC IF(ICOL.EQ.'RED')JCOL=1
CCCCC IF(ICOL.EQ.'BLUE')JCOL=4
CCCCC IF(ICOL.EQ.'PURP')JCOL=12
CCCCC IF(ICOL.EQ.'MAGE')JCOL=5
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
CCCCC IF(ICOL.EQ.'9')JCOL=9
CCCCC IF(ICOL.EQ.'10')JCOL=10
CCCCC IF(ICOL.EQ.'11')JCOL=11
CCCCC IF(ICOL.EQ.'12')JCOL=12
CCCCC IF(ICOL.EQ.'13')JCOL=13
CCCCC IF(ICOL.EQ.'14')JCOL=14
CCCCC IF(ICOL.EQ.'15')JCOL=15
CCCCC IF(ICOL(1:1).EQ.'-')THEN
CCCCC   ICOLT(1:4)='-   '
CCCCC   DO8610I=2,4
CCCCC     IF(ICOL(I:I).EQ.' ')GOTO8615
CCCCC     IF(ICOL(I:I).EQ.'.')GOTO8615
CCCCC     CALL DPCOAN(ICOL(I:I),ITEMP)
CCCCC     IF(ITEMP.GE.48.AND.ITEMP.LE.57)THEN
CCCCC       ICOLT(I:I)=ICOL(I:I)
CCCCC     ELSE
CCCCC       GOTO8619
CCCCC     ENDIF
C8610   CONTINUE
C8615   CONTINUE
CCCCC   READ(ICOLT(1:4),'(I4)')JCOL
CCCCC   IF(JCOL.LT.-256)JCOL=-256
CCCCC   IF(JCOL.GT.-1)JCOL=-1
CCCCC END IF
C8619 CONTINUE
      JCOL=2
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(IGCOLO.NE.'ON')GOTO9000
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE (QMS, TELARIS LASER PRINTERS**
C               **  QUIC DOES NOT SUPPORT COLOR.  HOWEVER, IT DOES  **
C               **  SUPPORT "HALF-TONES" AND "FILL PATTERNS".  THESE**
C               **  ARE DESCRIBED IN CHAPTER 8 OF THE QMS QUIC      **
C               **  PROGRAMMERS MANUAL.  HOWEVER, THESE WILL NOT BE **
C               **  BE USED TO SIMULATE COLOR FOR REGION FILLS (AS  **
C               **  IN POSTSCRIPT AND PCL CASES).  THE REASON IS    **
C               **  POSTSCRIPT SUPPORTS GREYSCALE AS A DIRECTLY     **
C               **  SPECIFIED PROPORTION AND PCL SUPPORTS DOT       **
C               **  DENSITY AS A DIRECTLY SPECIFIED PERCENT.  THE   **
C               **  QMS HALFTONES ARE SPECIFIC PREDFINED PATTERNS,  **
C               **  THERE DID NOT SEEM TO BE A REASONABLE "PROGRESSION"
C               **  IN THE PATTERNS LISTED IN THE MANUAL.           **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               ******************************************************
C
 9600 CONTINUE
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JX11(JINDEX+1)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 74.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 310.                       **
C               *************************************************
C
10000 CONTINUE
      JCOL=0
CCCCC IF(ICOL.EQ.'BLAC')JCOL=0
CCCCC IF(ICOL.EQ.'BLUE')JCOL=1
CCCCC IF(ICOL.EQ.'GREE')JCOL=2
CCCCC IF(ICOL.EQ.'CYAN')JCOL=3
CCCCC IF(ICOL.EQ.'RED')JCOL=4
CCCCC IF(ICOL.EQ.'MAGE')JCOL=5
CCCCC IF(ICOL.EQ.'BROW')JCOL=6
CCCCC IF(ICOL.EQ.'GRAY')JCOL=7
CCCCC IF(ICOL.EQ.'GREY')JCOL=7
CCCCC IF(ICOL.EQ.'LGRA')JCOL=7
CCCCC IF(ICOL.EQ.'LGRE')JCOL=7
CCCCC IF(ICOL.EQ.'DGRA')JCOL=8
CCCCC IF(ICOL.EQ.'DGRE')JCOL=8
CCCCC IF(ICOL.EQ.'LBLU')JCOL=9
CCCCC IF(ICOL.EQ.'LGRE')JCOL=10
CCCCC IF(ICOL.EQ.'LCYA')JCOL=11
CCCCC IF(ICOL.EQ.'LRED')JCOL=12
CCCCC IF(ICOL.EQ.'LMAG')JCOL=13
CCCCC IF(ICOL.EQ.'YELL')JCOL=14
CCCCC IF(ICOL.EQ.'WHIT')JCOL=15
C
CCCCC IF(ICOL.EQ.'0')JCOL=0
CCCCC IF(ICOL.EQ.'1')JCOL=1
CCCCC IF(ICOL.EQ.'2')JCOL=2
CCCCC IF(ICOL.EQ.'3')JCOL=3
CCCCC IF(ICOL.EQ.'4')JCOL=4
CCCCC IF(ICOL.EQ.'5')JCOL=5
CCCCC IF(ICOL.EQ.'6')JCOL=6
CCCCC IF(ICOL.EQ.'7')JCOL=7
CCCCC IF(ICOL.EQ.'8')JCOL=8
CCCCC IF(ICOL.EQ.'9')JCOL=9
CCCCC IF(ICOL.EQ.'10')JCOL=10
CCCCC IF(ICOL.EQ.'11')JCOL=11
CCCCC IF(ICOL.EQ.'12')JCOL=12
CCCCC IF(ICOL.EQ.'13')JCOL=13
CCCCC IF(ICOL.EQ.'14')JCOL=14
CCCCC IF(ICOL.EQ.'15')JCOL=15
      IF(JINDEX.LT.0)JCOL=0
      IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
C
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      JCOL=0
C
      IF(JINDEX.LT.0)JCOL=JINDEX
      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3
 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IGCODE
 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3
 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGBAUD
 9015 FORMAT('IGBAUD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ICASE
 9016 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)ICOL,JCOL
 9017 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)JINDEX
 9018 FORMAT('JINDEX = ',I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)NCSTR
 9023 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9027
      DO9025I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9027 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRDI(ICASE,IDIR,ANGLE,JDIR,ANGLE2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A DIRECTION GIVEN IN CHARACTER REPRESENTATION
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IDIR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRDI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDIR,ANGLE
   53 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 0--                       **
C               **  DEFINE DIRECTION               **
C               **  FOR A GENERAL GRAPHICS DEVICE  **
C               *************************************
C
      JDIR=0
      ANGLE2=ANGLE
C
      IF(IDIR.EQ.'HORI')JDIR=0
      IF(IDIR.EQ.'HORI')ANGLE2=0.0
C
      IF(IDIR.EQ.'VERT')JDIR=90
      IF(IDIR.EQ.'VERT')ANGLE2=90.0
C
      IF(IDIR.EQ.'GENE')JDIR=ANGLE+0.5
      IF(IDIR.EQ.'GENE')ANGLE2=ANGLE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-10, XXX.                         **
C               **********************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)*
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM CASE                              **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS CASE                            **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC CASE                             **
C               **  SUPPORT THE PROPORTIONAL FONTS THAT ARE         **
C               **  "HARD-CODED" IN THE QMS.                        **
C               **                                                  **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11     CASE                          **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRDI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRDI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDIR,ANGLE
 9013 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)JDIR,ANGLE2
 9014 FORMAT('JDIR,ANGLE2 = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IMANUF,IMODEL
 9015 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRFI(ICASE,IFILLT,JFILLT)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A FILL SPECIFICATION (ON/OFF) GIVEN IN CHARACTER REPRES
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IFILLT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFILLT
   53 FORMAT('IFILLT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 0--                       **
C               **  DEFINE FILL                    **
C               **  FOR A GENERAL GRAPHICS DEVICE  **
C               *************************************
C
      JFILLT=0
      IF(IFILLT.EQ.'ON')JFILLT=1
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1090
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HP-2622   CASE                        **
C               ******************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM       CASE                        **
C               ******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFILLT,JFILLT
 9013 FORMAT('IFILLT,JFILLT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRFO(ICASE,IFONT,JFONT)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A FONT GIVEN IN CHARACTER REPRESENTATION
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD, CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IFONT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFONT
   53 FORMAT('IFONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 0--                       **
C               **  DEFINE FONT                    **
C               **  FOR A GENERAL GRAPHICS DEVICE  **
C               *************************************
C
      JFONT=0
      IF(IFONT.EQ.'TEKT')JFONT=0
      IF(IFONT.EQ.'SIMP')JFONT=1
      IF(IFONT.EQ.'DUPL')JFONT=2
      IF(IFONT.EQ.'TRIP')JFONT=3
      IF(IFONT.EQ.'COMP')JFONT=4
      IF(IFONT.EQ.'TRII')JFONT=5
      IF(IFONT.EQ.'SIMS')JFONT=6
      IF(IFONT.EQ.'COMS')JFONT=7
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HP-2622   CASE                        **
C               ******************************************************
C
 2300 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE GENERAL CGM                  CASE     **
C               ******************************************************
C
 3300 CONTINUE
      JFONT=JFONT+1
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRFO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFONT,JFONT
 9013 FORMAT('IFONT,JFONT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRJU(ICASE,IJUST,JJUST)
C
C     PURPOSE--FOR A TEXT STRING, MARKER, LINE, OR AREA,
C              TRANSLATE A JUSTIFICATION GIVEN IN CHARACTER REPRESENTATION
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. LATEK
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRJU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IJUST
   53 FORMAT('IJUST = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 0--                       **
C               **  DEFINE JUSTIFICATION           **
C               **  FOR A GENERAL GRAPHICS DEVICE  **
C               *************************************
C
      JJUST=1
      IF(IJUST.EQ.'LEFT')JJUST=1
      IF(IJUST.EQ.'CENT')JJUST=2
      IF(IJUST.EQ.'RIGH')JJUST=3
C
      IF(IJUST.EQ.'LJUS')JJUST=1
      IF(IJUST.EQ.'CJUS')JJUST=2
      IF(IJUST.EQ.'RJUS')JJUST=3
C
      IF(IJUST.EQ.'LEBO')JJUST=1
      IF(IJUST.EQ.'CEBO')JJUST=2
      IF(IJUST.EQ.'RIBO')JJUST=3
      IF(IJUST.EQ.'LECE')JJUST=4
      IF(IJUST.EQ.'CECE')JJUST=5
      IF(IJUST.EQ.'RICE')JJUST=6
      IF(IJUST.EQ.'LETO')JJUST=7
      IF(IJUST.EQ.'CETO')JJUST=8
      IF(IJUST.EQ.'RITO')JJUST=9
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL       CASE                        **
C               ******************************************************
C
 2600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 33--                                    **
C               **  TREAT THE CGM (ASCII)                  CASE  **
C               ***************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               ******************************************************
C
 9100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               *************************************************
C
10000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRJU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRJU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IJUST,JJUST
 9013 FORMAT('IJUST,JJUST = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRPA(ICASE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A PATTERN IN CHARACTER REPRESENTTION.
C              INTO A NUMERIC REPRESENTATION
C              THAT WILL BE UNDERSTOOD BY THE SPECIFIC
C              GRAPHICS DEVICE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. SET PATTERN TO -1 FOR BLANK LINE
C                                      IF DEVICE DOESN'T ALREADY SET
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
C                                      LIBRARY)
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --FEBRUARY 2006. LATEX
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IPATTT
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IPATTT
   53 FORMAT('IPATTT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PXSPA,PYSPA
   54 FORMAT('PXSPA,PYSPA = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)IMANUF,IMODEL
   58 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4020')GOTO1200
      IF(IMODEL.EQ.'4022')GOTO1200
      IF(IMODEL.EQ.'4025')GOTO1200
      IF(IMODEL.EQ.'4027')GOTO1200
C
      IF(IMODEL.EQ.'4105')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4109')GOTO1300
      IF(IMODEL.EQ.'4115')GOTO1300
      IF(IMODEL.EQ.'4107')GOTO1300
      IF(IMODEL.EQ.'4113')GOTO1300
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ********************************
C               **  STEP 11--                 **
C               **  TREAT THE TEKTRONIX 4014  **
C               **  REFERENCE--40Z105 MANUAL, PAGE 5-52            **
C               ********************************
C
 1100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO1110
      IF(ICASE.EQ.'REGI')GOTO1120
      IF(ICASE.EQ.'MARK')GOTO1130
      IF(ICASE.EQ.'TEXT')GOTO1140
      GOTO1110
C
 1110 CONTINUE
      JPATTT=96
      IF(IPATTT.EQ.'SOLI')JPATTT=96
      IF(IPATTT.EQ.'SO')JPATTT=96
      IF(IPATTT.EQ.'DOTT')JPATTT=97
      IF(IPATTT.EQ.'DOT')JPATTT=97
      IF(IPATTT.EQ.'DO')JPATTT=97
      IF(IPATTT.EQ.'DASH')JPATTT=99
      IF(IPATTT.EQ.'DA')JPATTT=99
      IF(IPATTT.EQ.'DA1')JPATTT=100
      IF(IPATTT.EQ.'DA2')JPATTT=98
      IF(IPATTT.EQ.'DA3')JPATTT=102
      IF(IPATTT.EQ.'DA4')JPATTT=101
      IF(IPATTT.EQ.'DA5')JPATTT=103
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 1120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 1130 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      GOTO9000
C
C               ****************************************************
C               **  STEP 12--                                     **
C               **  TREAT THE TEKTRONIX 4027                      **
C               **  (COLOR RASTER DEVICE).                        **
C               **  TO SET LINE PATTERN,                          **
C               **  XXX    **
C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE XXX.    **
C               ****************************************************
C
 1200 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO1210
      IF(ICASE.EQ.'REGI')GOTO1220
      IF(ICASE.EQ.'MARK')GOTO1230
      IF(ICASE.EQ.'TEXT')GOTO1240
      GOTO1240
C
 1210 CONTINUE
      JPATTT=1
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=4
      IF(IPATTT.EQ.'DA2')JPATTT=5
      IF(IPATTT.EQ.'DA3')JPATTT=6
      IF(IPATTT.EQ.'DA4')JPATTT=7
      IF(IPATTT.EQ.'DA5')JPATTT=8
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 1220 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 1230 CONTINUE
      GOTO9000
C
 1240 CONTINUE
      GOTO9000
C
C               *************************************
C               **  STEP 13--                      **
C               **  TREAT THE TEKTRONIX 4105 CASE  **
C               **  (COLOR RASTER DEVICE)          **
C               **  REFERENCE--XXX                 **
C               *************************************
C
 1300 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO1310
      IF(ICASE.EQ.'REGI')GOTO1320
      IF(ICASE.EQ.'MARK')GOTO1330
      IF(ICASE.EQ.'TEXT')GOTO1340
      GOTO1310
C
 1310 CONTINUE
      JPATTT=96
      IF(IPATTT.EQ.'SOLI')JPATTT=96
      IF(IPATTT.EQ.'SO')JPATTT=96
      IF(IPATTT.EQ.'DOTT')JPATTT=97
      IF(IPATTT.EQ.'DOT')JPATTT=97
      IF(IPATTT.EQ.'DO')JPATTT=97
      IF(IPATTT.EQ.'DASH')JPATTT=99
      IF(IPATTT.EQ.'DA')JPATTT=99
      IF(IPATTT.EQ.'DA1')JPATTT=100
      IF(IPATTT.EQ.'DA2')JPATTT=98
      IF(IPATTT.EQ.'DA3')JPATTT=102
      IF(IPATTT.EQ.'DA4')JPATTT=101
      IF(IPATTT.EQ.'DA5')JPATTT=103
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 1320 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
CCCCC IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
CCCCC IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
CCCCC IF(IPATTT.EQ.'FILL')PXSPA2=0.1
CCCCC IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 1330 CONTINUE
      GOTO9000
C
 1340 CONTINUE
      GOTO9000
C               ****************************************************
C               **  STEP 21--                                     **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
C               **             OPERATING AND PROGRAMMING MANUAL,  **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2110
      IF(ICASE.EQ.'REGI')GOTO2120
      IF(ICASE.EQ.'MARK')GOTO2130
      IF(ICASE.EQ.'TEXT')GOTO2140
      GOTO2110
C
 2110 CONTINUE
      GOTO9000
C
 2120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 2130 CONTINUE
      GOTO9000
C
 2140 CONTINUE
      GOTO9000
C               ****************************************************
C               **  STEP 22--                                     **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASE          **
C               **  (MULTI-COLOR PENPLOTTER)                      **
C               **  REFERENCE--                                   **
C               **                                                **
C               **             PAGE XX.                           **
C               ****************************************************
C
 2200 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2210
      IF(ICASE.EQ.'REGI')GOTO2220
      IF(ICASE.EQ.'MARK')GOTO2230
      IF(ICASE.EQ.'TEXT')GOTO2240
      GOTO2210
C
 2210 CONTINUE
      JPATTT=-1
      IF(IPATTT.EQ.'BLAN')JPATTT=0
      IF(IPATTT.EQ.'BL  ')JPATTT=0
      IF(IPATTT.EQ.'NONE')JPATTT=0
      IF(IPATTT.EQ.'NO  ')JPATTT=0
      IF(IPATTT.EQ.'    ')JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=-1
      IF(IPATTT.EQ.'SO  ')JPATTT=-1
      IF(IPATTT.EQ.'DOTT')JPATTT=1
      IF(IPATTT.EQ.'DOT ')JPATTT=1
      IF(IPATTT.EQ.'DO  ')JPATTT=1
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA  ')JPATTT=2
      IF(IPATTT.EQ.'DA1 ')JPATTT=3
      IF(IPATTT.EQ.'DA2 ')JPATTT=4
      IF(IPATTT.EQ.'DA3 ')JPATTT=5
      IF(IPATTT.EQ.'DA4 ')JPATTT=6
      GOTO9000
C
 2220 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 2230 CONTINUE
      GOTO9000
C
 2240 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-6, 10-7.                         **
C               **********************************************************
C
 2300 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2310
      IF(ICASE.EQ.'REGI')GOTO2320
      IF(ICASE.EQ.'MARK')GOTO2330
      IF(ICASE.EQ.'TEXT')GOTO2340
      GOTO2310
C
 2310 CONTINUE
      JPATTT=1
      IF(IPATTT.EQ.'BLAN')JPATTT=11
      IF(IPATTT.EQ.'BL  ')JPATTT=11
      IF(IPATTT.EQ.'NONE')JPATTT=11
      IF(IPATTT.EQ.'NO  ')JPATTT=11
      IF(IPATTT.EQ.'    ')JPATTT=11
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO  ')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=7
      IF(IPATTT.EQ.'DOT ')JPATTT=7
      IF(IPATTT.EQ.'DO  ')JPATTT=7
      IF(IPATTT.EQ.'DASH')JPATTT=6
      IF(IPATTT.EQ.'DA  ')JPATTT=6
      IF(IPATTT.EQ.'DA1 ')JPATTT=5
      IF(IPATTT.EQ.'DA2 ')JPATTT=4
      IF(IPATTT.EQ.'DA3 ')JPATTT=10
      IF(IPATTT.EQ.'DA4 ')JPATTT=8
C
 2320 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 2330 CONTINUE
      GOTO9000
C
 2340 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **********************************************************
C
 2600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO2610
      IF(ICASE.EQ.'REGI')GOTO2620
      IF(ICASE.EQ.'MARK')GOTO2630
      IF(ICASE.EQ.'TEXT')GOTO2640
      GOTO2610
C
 2610 CONTINUE
C
 2620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      GOTO9000
C
 2630 CONTINUE
      GOTO9000
C
 2640 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 31--                                    **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
C               ***************************************************
C
 3100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO3110
      IF(ICASE.EQ.'REGI')GOTO3120
      IF(ICASE.EQ.'MARK')GOTO3130
      IF(ICASE.EQ.'TEXT')GOTO3140
      GOTO3110
C
 3110 CONTINUE
      GOTO9000
C
 3120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
C  MARCH, 1988
CCCCC IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
CCCCC IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
CCCCC IF(IPATTT.EQ.'FILL')PXSPA2=0.1
CCCCC IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW
      IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW
      IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW
      IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW
      GOTO9000
C
 3130 CONTINUE
      GOTO9000
C
 3140 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE CGM       CASE                        **
C               **  LINE                                            **
C               **    1 - SOLID                                     **
C               **    2 - DASH                                      **
C               **    3 - DOT                                       **
C               **    4 - DASH-DOT                                  **
C               **    5 - DASH-DOT-DOT                              **
C               **  REGION                                          **
C               **    1 - PARALLEL HORIZONTAL LINES                 **
C               **    2 - PARALLEL VERTICAL LINES                   **
C               **    3 - 45 DEGREE LINES                           **
C               **    4 - 135 DEGREE LINES                          **
C               **    5 - CROSS-HATCH WITH 45 AND 135 DEGREE LINES  **
C               **  MARKERS AND TEXT PATTERNS NOT CURRENTLY         **
C               **  UTILIZED BY DATAPLOT                            **
C               ******************************************************
C
 3300 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO3310
      IF(ICASE.EQ.'REGI')GOTO3320
      IF(ICASE.EQ.'MARK')GOTO3330
      IF(ICASE.EQ.'TEXT')GOTO3340
      GOTO3310
C
 3310 CONTINUE
      JPATT=1
      IF(IPATTT.EQ.'BLAN')JPATTT=0
      IF(IPATTT.EQ.'BL  ')JPATTT=0
      IF(IPATTT.EQ.'NONE')JPATTT=0
      IF(IPATTT.EQ.'NO  ')JPATTT=0
      IF(IPATTT.EQ.'    ')JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO  ')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT ')JPATTT=3
      IF(IPATTT.EQ.'DO  ')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA  ')JPATTT=2
      IF(IPATTT.EQ.'DA1 ')JPATTT=4
      IF(IPATTT.EQ.'DA2 ')JPATTT=5
      IF(IPATTT.EQ.'DA3 ')JPATTT=4
      IF(IPATTT.EQ.'DA4 ')JPATTT=5
      GOTO9000
C
C     NOTE: PPENSW IS THE WIDTH OF A SINGLE LINE FOR METAFILES.
C           USER SETTABLE VIA "SET GENERAL PEN WIDTH <WIDTH>"
C
 3320 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'FILL')JPATTT=0
      IF(IPATTT.EQ.'HORI')JPATTT=1
      IF(IPATTT.EQ.'VERT')JPATTT=2
      IF(IPATTT.EQ.'D1')JPATTT=3
      IF(IPATTT.EQ.'D2')JPATTT=4
      IF(IPATTT.EQ.'HV')JPATTT=5
      IF(IPATTT.EQ.'D1D2')JPATTT=6
      IF(IPATTT.EQ.'HD1')JPATTT=6
      IF(IPATTT.EQ.'HD2')JPATTT=6
      IF(IPATTT.EQ.'VD1')JPATTT=6
      IF(IPATTT.EQ.'VD2')JPATTT=6
      IF(IPATTT.EQ.'HVD1')JPATTT=6
      IF(IPATTT.EQ.'HVD2')JPATTT=6
      IF(IPATTT.EQ.'ALL')JPATTT=6
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW
      IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW
      IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW
      IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW
      GOTO9000
C
 3330 CONTINUE
      GOTO9000
C
 3340 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4110
      IF(ICASE.EQ.'REGI')GOTO4120
      IF(ICASE.EQ.'MARK')GOTO4130
      IF(ICASE.EQ.'TEXT')GOTO4140
      GOTO4110
C
 4110 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=1
      IF(IPATTT.EQ.'DA')JPATTT=1
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 4120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=PCALTH
      IF(IPATTT.EQ.'SOLI')PYSPA2=PCALTH
      IF(IPATTT.EQ.'FILL')PXSPA2=PCALTH
      IF(IPATTT.EQ.'FILL')PYSPA2=PCALTH
      GOTO9000
C
 4130 CONTINUE
      GOTO9000
C
 4140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4610
      IF(ICASE.EQ.'REGI')GOTO4620
      IF(ICASE.EQ.'MARK')GOTO4630
      IF(ICASE.EQ.'TEXT')GOTO4640
      GOTO4610
C
 4610 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=1
      IF(IPATTT.EQ.'DA')JPATTT=1
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 4620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=PCALTH
      IF(IPATTT.EQ.'SOLI')PYSPA2=PCALTH
      IF(IPATTT.EQ.'FILL')PXSPA2=PCALTH
      IF(IPATTT.EQ.'FILL')PYSPA2=PCALTH
      GOTO9000
C
 4630 CONTINUE
      GOTO9000
C
 4640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4710
      IF(ICASE.EQ.'REGI')GOTO4720
      IF(ICASE.EQ.'MARK')GOTO4730
      IF(ICASE.EQ.'TEXT')GOTO4740
      GOTO4710
C
 4710 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=3
      IF(IPATTT.EQ.'DA')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 4720 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 4730 CONTINUE
      GOTO9000
C
 4740 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4810
      IF(ICASE.EQ.'REGI')GOTO4820
      IF(ICASE.EQ.'MARK')GOTO4830
      IF(ICASE.EQ.'TEXT')GOTO4840
      GOTO4810
C
 4810 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=3
      IF(IPATTT.EQ.'DA')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 4820 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 4830 CONTINUE
      GOTO9000
C
 4840 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO4960
      IF(ICASE.EQ.'REGI')GOTO4970
      IF(ICASE.EQ.'MARK')GOTO4980
      IF(ICASE.EQ.'TEXT')GOTO4990
      GOTO4960
C
 4960 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=1
      IF(IPATTT.EQ.'DOT')JPATTT=1
      IF(IPATTT.EQ.'DO')JPATTT=1
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=3
      IF(IPATTT.EQ.'DA4')JPATTT=4
      IF(IPATTT.EQ.'DA5')JPATTT=3
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 4970 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 4980 CONTINUE
      GOTO9000
C
 4990 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  USE ZETA EXTENSION TO STANDARD CALCOMP LIBRARY  **
C               **  ALTHOUGH USER CAN DEFINE THE DASH PATTERN, USE  **
C               **  THE 6 PRE-DEFINED DASH PATTERNS                 **
C               ******************************************************
C
 5100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO5110
      IF(ICASE.EQ.'REGI')GOTO5120
      IF(ICASE.EQ.'MARK')GOTO5130
      IF(ICASE.EQ.'TEXT')GOTO5140
      GOTO5110
C
 5110 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=1
      IF(IPATTT.EQ.'DA')JPATTT=1
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=1
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 5120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=PZETTH
      IF(IPATTT.EQ.'SOLI')PYSPA2=PZETTH
      IF(IPATTT.EQ.'FILL')PXSPA2=PZETTH
      IF(IPATTT.EQ.'FILL')PYSPA2=PZETTH
      GOTO9000
C
 5130 CONTINUE
      GOTO9000
C
 5140 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO6110
      IF(ICASE.EQ.'REGI')GOTO6120
      IF(ICASE.EQ.'MARK')GOTO6130
      IF(ICASE.EQ.'TEXT')GOTO6140
      GOTO6110
C
 6110 CONTINUE
      GOTO9000
C
 6120 CONTINUE
      GOTO9000
C
 6130 CONTINUE
      GOTO9000
C
 6140 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO6610
      IF(ICASE.EQ.'REGI')GOTO6620
      IF(ICASE.EQ.'MARK')GOTO6630
      IF(ICASE.EQ.'TEXT')GOTO6640
      GOTO6610
C
 6610 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO  ')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=1
      IF(IPATTT.EQ.'DOT ')JPATTT=1
      IF(IPATTT.EQ.'DO  ')JPATTT=1
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA  ')JPATTT=2
      IF(IPATTT.EQ.'DA1 ')JPATTT=3
      IF(IPATTT.EQ.'DA2 ')JPATTT=4
      IF(IPATTT.EQ.'DA3 ')JPATTT=5
      GOTO9000
C
 6620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 6630 CONTINUE
      GOTO9000
C
 6640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO7110
      IF(ICASE.EQ.'REGI')GOTO7120
      IF(ICASE.EQ.'MARK')GOTO7130
      IF(ICASE.EQ.'TEXT')GOTO7140
      GOTO7110
C
 7110 CONTINUE
      GOTO9000
C
 7120 CONTINUE
      GOTO9000
C
 7130 CONTINUE
      GOTO9000
C
 7140 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO8110
      IF(ICASE.EQ.'REGI')GOTO8120
      IF(ICASE.EQ.'MARK')GOTO8130
      IF(ICASE.EQ.'TEXT')GOTO8140
      GOTO8110
C
 8110 CONTINUE
      JPATTT=1
      IF(IPATTT.EQ.'BLAN')JPATTT=0
      IF(IPATTT.EQ.'BL  ')JPATTT=0
      IF(IPATTT.EQ.'NONE')JPATTT=0
      IF(IPATTT.EQ.'NO  ')JPATTT=0
      IF(IPATTT.EQ.'    ')JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=4
      IF(IPATTT.EQ.'DOT')JPATTT=4
      IF(IPATTT.EQ.'DO')JPATTT=4
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=5
      IF(IPATTT.EQ.'DA3')JPATTT=6
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=6
      GOTO9000
C
 8120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 8130 CONTINUE
      GOTO9000
C
 8140 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO8610
      IF(ICASE.EQ.'REGI')GOTO8620
      IF(ICASE.EQ.'MARK')GOTO8630
      IF(ICASE.EQ.'TEXT')GOTO8640
      GOTO8610
C
 8610 CONTINUE
      JPATTT=1
      IF(IPATTT.EQ.'BLAN')JPATTT=0
      IF(IPATTT.EQ.'BL  ')JPATTT=0
      IF(IPATTT.EQ.'NONE')JPATTT=0
      IF(IPATTT.EQ.'NO  ')JPATTT=0
      IF(IPATTT.EQ.'    ')JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=3
      IF(IPATTT.EQ.'DA')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=4
      IF(IPATTT.EQ.'DA2')JPATTT=5
      IF(IPATTT.EQ.'DA3')JPATTT=6
      IF(IPATTT.EQ.'DA4')JPATTT=7
      IF(IPATTT.EQ.'DA5')JPATTT=7
      GOTO9000
C
 8620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      GOTO9000
C
 8630 CONTINUE
      GOTO9000
C
 8640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO8910
      IF(ICASE.EQ.'REGI')GOTO8920
      IF(ICASE.EQ.'MARK')GOTO8930
      IF(ICASE.EQ.'TEXT')GOTO8940
      GOTO8910
C
 8910 CONTINUE
      JPATTT=1
      IF(IPATTT.EQ.'BLAN')JPATTT=0
      IF(IPATTT.EQ.'BL  ')JPATTT=0
      IF(IPATTT.EQ.'NONE')JPATTT=0
      IF(IPATTT.EQ.'NO  ')JPATTT=0
      IF(IPATTT.EQ.'    ')JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=3
      IF(IPATTT.EQ.'DA')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=4
      IF(IPATTT.EQ.'DA2')JPATTT=5
      IF(IPATTT.EQ.'DA3')JPATTT=6
      IF(IPATTT.EQ.'DA4')JPATTT=7
      IF(IPATTT.EQ.'DA5')JPATTT=7
      GOTO9000
C
 8920 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      GOTO9000
C
 8930 CONTINUE
      GOTO9000
C
 8940 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               **  USE THE PREDEFINED PATTERNS                     **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL FROM QMS     **
C               **  P 14-7                                          **
C               ******************************************************
C
 9100 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO9110
      IF(ICASE.EQ.'REGI')GOTO9120
      IF(ICASE.EQ.'MARK')GOTO9130
      IF(ICASE.EQ.'TEXT')GOTO9140
      GOTO9110
C
 9110 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=1
      IF(IPATTT.EQ.'DA')JPATTT=1
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 9120 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
C
C  LINE WILL BE 3 PIXELS WIDE.  BASE SPACING FOR SOLID FILL ON
C  NUMBER OF HORIZONTAL PICTURE POINTS.
C
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=100.*(3./ANUMHP)
      IF(IPATTT.EQ.'SOLI')PYSPA2=100.*(3./ANUMVP)
      IF(IPATTT.EQ.'FILL')PXSPA2=100.*(3./ANUMHP)
      IF(IPATTT.EQ.'FILL')PYSPA2=100.*(3./ANUMVP)
      GOTO9000
C
 9130 CONTINUE
      GOTO9000
C
 9140 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11       CASE                        **
C               **  NOTE THAT FOR LINE PATTERNS, A SOLID, DASH, DOT,**
C               **  AND DASH-DOT PATTERNS ARE DEFINED IN THE C      **
C               **  LIBRARY.  CURRENTLY, DASH1-DASH5 ALL SET THE SAME*
C               **  DASH-DOT PATTERN.  HOWEVER, THE NUMBER OF DASH  **
C               **  PATTERNS MAY BE INCREASED IN THE FUTURE (THE    **
C               **  CAN DEFINE ARBITRARY DASH PATTERNS).            **
C               **  X11 DOES NOT DEFINE ANY HATCH PATTERNS.  IT DOES**
C               **  ALLOW PRE-BUILT BIT ARRAYS (USUALLY 8X8 OR 16X16**
C               **  PIXELS) TO FILL REGIONS WITH PATTERNS.  HOWEVER,**
C               **  THIS IS NOT CONSISTENT WITH HOW DATAPLOT DEFINES**
C               **  PATTERNS, SO LET DATAPLOT DO REGION FILLS IN    **
C               **  SOFTWARE.                                       **
C               ******************************************************
C
 9600 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO9610
      IF(ICASE.EQ.'REGI')GOTO9620
      IF(ICASE.EQ.'MARK')GOTO9630
      IF(ICASE.EQ.'TEXT')GOTO9640
      GOTO9610
C
 9610 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=2
      IF(IPATTT.EQ.'DOT')JPATTT=2
      IF(IPATTT.EQ.'DO')JPATTT=2
      IF(IPATTT.EQ.'DASH')JPATTT=1
      IF(IPATTT.EQ.'DA')JPATTT=1
      IF(IPATTT.EQ.'DA1')JPATTT=3
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
 9620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
 9630 CONTINUE
      GOTO9000
C
 9640 CONTINUE
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 83.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 320.                       **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 29.         **
C               *************************************************
C
10000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO10610
      IF(ICASE.EQ.'REGI')GOTO10620
      IF(ICASE.EQ.'MARK')GOTO10630
      IF(ICASE.EQ.'TEXT')GOTO10640
      GOTO10610
C
10610 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=0
      IF(IPATTT.EQ.'SO')JPATTT=0
      IF(IPATTT.EQ.'DOTT')JPATTT=1
      IF(IPATTT.EQ.'DOT')JPATTT=1
      IF(IPATTT.EQ.'DO')JPATTT=1
      IF(IPATTT.EQ.'DASH')JPATTT=3
      IF(IPATTT.EQ.'DA')JPATTT=3
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=2
      IF(IPATTT.EQ.'DA3')JPATTT=2
      IF(IPATTT.EQ.'DA4')JPATTT=2
      IF(IPATTT.EQ.'DA5')JPATTT=2
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
10620 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
10630 CONTINUE
      GOTO9000
C
10640 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO11010
      IF(ICASE.EQ.'REGI')GOTO11020
      IF(ICASE.EQ.'MARK')GOTO11030
      IF(ICASE.EQ.'TEXT')GOTO11040
      GOTO11010
C
11010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
11020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
11030 CONTINUE
      GOTO9000
C
11040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO12010
      IF(ICASE.EQ.'REGI')GOTO12020
      IF(ICASE.EQ.'MARK')GOTO12030
      IF(ICASE.EQ.'TEXT')GOTO12040
      GOTO12010
C
12010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
12020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
12030 CONTINUE
      GOTO9000
C
12040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO13010
      IF(ICASE.EQ.'REGI')GOTO13020
      IF(ICASE.EQ.'MARK')GOTO13030
      IF(ICASE.EQ.'TEXT')GOTO13040
      GOTO13010
C
13010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
13020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
13030 CONTINUE
      GOTO9000
C
13040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO14010
      IF(ICASE.EQ.'REGI')GOTO14020
      IF(ICASE.EQ.'MARK')GOTO14030
      IF(ICASE.EQ.'TEXT')GOTO14040
      GOTO14010
C
14010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
14020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
14030 CONTINUE
      GOTO9000
C
14040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)            DRIVER **
C               ******************************************************
15000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO15010
      IF(ICASE.EQ.'REGI')GOTO15020
      IF(ICASE.EQ.'MARK')GOTO15030
      IF(ICASE.EQ.'TEXT')GOTO15040
      GOTO15010
C
15010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=2
      IF(IPATTT.EQ.'DA2')JPATTT=4
      IF(IPATTT.EQ.'DA3')JPATTT=5
      IF(IPATTT.EQ.'DA4')JPATTT=6
      IF(IPATTT.EQ.'DA5')JPATTT=7
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
15020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
15030 CONTINUE
      GOTO9000
C
15040 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      IF(ICASE.EQ.'LINE')GOTO16010
      IF(ICASE.EQ.'REGI')GOTO16020
      IF(ICASE.EQ.'MARK')GOTO16030
      IF(ICASE.EQ.'TEXT')GOTO16040
      GOTO16010
C
16010 CONTINUE
      JPATTT=0
      IF(IPATTT.EQ.'SOLI')JPATTT=1
      IF(IPATTT.EQ.'SO')JPATTT=1
      IF(IPATTT.EQ.'DOTT')JPATTT=3
      IF(IPATTT.EQ.'DOT')JPATTT=3
      IF(IPATTT.EQ.'DO')JPATTT=3
      IF(IPATTT.EQ.'DASH')JPATTT=2
      IF(IPATTT.EQ.'DA')JPATTT=2
      IF(IPATTT.EQ.'DA1')JPATTT=4
      IF(IPATTT.EQ.'DA2')JPATTT=5
      IF(IPATTT.EQ.'DA3')JPATTT=6
      IF(IPATTT.EQ.'DA4')JPATTT=7
      IF(IPATTT.EQ.'DA5')JPATTT=8
      IF(IPATTT.EQ.'BLAN')JPATTT=-1
      IF(IPATTT.EQ.'BL  ')JPATTT=-1
      IF(IPATTT.EQ.'NONE')JPATTT=-1
      IF(IPATTT.EQ.'NO  ')JPATTT=-1
      IF(IPATTT.EQ.'    ')JPATTT=-1
      GOTO9000
C
16020 CONTINUE
      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
      PXSPA2=PXSPA
      PYSPA2=PYSPA
      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
      GOTO9000
C
16030 CONTINUE
      GOTO9000
C
16040 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IPATTT,JPATTT
 9013 FORMAT('IPATTT,JPATTT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PXSPA,PYSPA,PXSPA2,PYSPA2
 9014 FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IHORPA,IVERPA,IDUPPA,IDDOPA
 9015 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IMANUF,IMODEL
 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRSI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A DESIRED SIZE (E.G., A CHARACTER SIZE)
C              (HEIGHT, WIDTH,
C              VERTICAL GAP, HORIZONTAL GAP9
C              GIVEN IN (0.0 TO 100.0) REPRESENTATION
C              INTO AN INTEGER NUMERIC REPRESENTATION (IN JSIZE)
C              THAT WILL BE UNDERSTOOD BY THE TEKTRONIX
C              GRAPHICS DEVICE BEING USED.
C              ALSO, CREATE OTHER VARIABLES WHICH CONTAIN
C              THE CLOSEST ALLOWABLE SIZES
C              (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON
C              THE TEKTRONIX GRAPHICS DEVICE BEING USED.
C
C     NOTE--PHEIGH IS IN RAW 0 TO 100 UNITS.
C           PHEIG2 IS ALSO IN 0 TO 100 UNITS BUT IS SCALED DOWN
C           TO REFLECT A SMALLER WINDOW (IF ONE EXISTS).
C           EXAMPLE--IF PHEIGH=3.0
C                    AND WINDOW IS FROM Y = 0 TO Y = 50,
C                    THEN PHEIG2=1.5
C
C     NOTE--THE ONLY VARIABLES IN THE    PLOT CONTROL COMMON
C           THAT ARE USED HEREIN ARE THE ONES IN /RWIND/
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PVONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MARCH    1991. REGIS FIX (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD, CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --SEPTEMBER1998. MULTIPLOT SCALE FACTOR
C     UPDATED         --AUGUST   1999. BUG FIX FOR MULTIPLOT SCALE
C                                      FACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
      CHARACTER*4 IFONT
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODV.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      PHEIPP=(-999.0)
      PWIDPP=(-999.0)
      PVEGPP=(-999.0)
      PHOGPP=(-999.0)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRSI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE,IFONT
   52 FORMAT('ICASE,IFONT = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   53 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IMANUF,IMODEL
   57 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCC PHEIG2=PHEIGH
CCCCC PWIDT2=PWIDTH
CCCCC PVEGA2=PVEGAP
CCCCC PHOGA2=PHOGAP
CCCCC AUGMENT FOLLOWING LINES TO SUPPORT MULTIPLOT SCALE FACTOR
      AFACTH=1.0
      AFACTW=1.0
      IF(IMPSW2.EQ.'ON'.AND.IFONT.EQ.'TEKT')THEN
        AFACTH=AMPSCH
        AFACTW=AMPSCW
      ENDIF
C
CCCCC DON'T ADJUST PHEIGH, ETC., ADJUST PHEIG2, ETC.   AUGUST 1999
CCCCC PHEIGH=PHEIGH*AFACTH
CCCCC PVEGAP=PVEGAP*AFACTH
CCCCC PWIDTH=PWIDTH*AFACTW
CCCCC PHOGAP=PHOGAP*AFACTW
C
CCCCC PHEIG2=PHEIGH*(PWYMAX-PWYMIN)/100.0
CCCCC PVEGA2=PVEGAP*(PWYMAX-PWYMIN)/100.0
CCCCC PWIDT2=PWIDTH*(PWXMAX-PWXMIN)/100.0
CCCCC PHOGA2=PHOGAP*(PWXMAX-PWXMIN)/100.0
C
      PHEIG2=(AFACTH*PHEIGH)*(PWYMAX-PWYMIN)/100.0
      PVEGA2=(AFACTH*PVEGAP)*(PWYMAX-PWYMIN)/100.0
      PWIDT2=(AFACTW*PWIDTH)*(PWXMAX-PWXMIN)/100.0
      PHOGA2=(AFACTW*PHOGAP)*(PWXMAX-PWXMIN)/100.0
C
      RATIVH=ANUMVP/ANUMHP
      RATIV1=ANUMVP/100.0
      IF(IFONT.NE.'TEKT')GOTO9000
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      IF(IMODEL.EQ.'4006')GOTO1100
      IF(IMODEL.EQ.'4010')GOTO1100
      IF(IMODEL.EQ.'4050')GOTO1100
      IF(IMODEL.EQ.'4052')GOTO1100
C
      IF(IMODEL.EQ.'4012')GOTO1200
      IF(IMODEL.EQ.'4013')GOTO1200
      IF(IMODEL.EQ.'4014')GOTO1200
      IF(IMODEL.EQ.'4016')GOTO1200
      IF(IMODEL.EQ.'4054')GOTO1200
C
      IF(IMODEL.EQ.'4020')GOTO1300
      IF(IMODEL.EQ.'4022')GOTO1300
      IF(IMODEL.EQ.'4025')GOTO1300
      IF(IMODEL.EQ.'4027')GOTO1300
C
      IF(IMODEL.EQ.'4105')GOTO1100
      IF(IMODEL.EQ.'4107')GOTO1100
      IF(IMODEL.EQ.'4109')GOTO1100
      IF(IMODEL.EQ.'4115')GOTO1100
      IF(IMODEL.EQ.'4107')GOTO1100
      IF(IMODEL.EQ.'4109')GOTO1100
C
      IF(IMODEL.EQ.'4113')GOTO1200
      IF(IMODEL.EQ.'4114')GOTO1200
C
      IF(IMODEL.EQ.'4662')GOTO1200
C
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               *******************************************************
C               **  STEP 11--                                        **
C               **  TREAT THE TEKTRONIX 4006, 4010, 4050, AND 4052   **
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES  **
C               **  WHICH ARE SMALL SCREEN AND SO HAVE ONLY          **
C               **  1 CHARCTER SIZE).                                **
C               **  REFERENCE--IGL MANUAL, PAGE 6-22                 **
C               *******************************************************
C
 1100 CONTINUE
      JSIZE=1
      PWIDPP=1.410*RATIV1
      PHOGPP=0.385*RATIV1
      PHEIPP=1.795*RATIV1
      PVEGPP=1.026*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=1.410*RATIVH
      PHOGA2=0.385*RATIVH
      PHEIG2=1.795
      PVEGA2=1.026
      GOTO9000
C
C               ****************************************************************
C               **  STEP 12--
C               **  TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, AND 4114
C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES
C               **  WHICH ARE LARGE SCREEN AND SO HAVE
C               **  4 CHARCTER SIZES.)
C               **  REFERENCE--IGL MANUAL, PAGE 6-22
C               ****************************************************************
C
 1200 CONTINUE
CCCCC IF(PHEIGH.LT.1.75)GOTO1211
CCCCC IF(1.75.LT.PHEIGH.AND.PHEIGH.LE.2.25)GOTO1212
CCCCC IF(2.25.LT.PHEIGH.AND.PHEIGH.LE.2.75)GOTO1213
      IF(PHEIG2.LT.0.75)GOTO1211
      IF(0.75.LT.PHEIG2.AND.PHEIG2.LE.1.25)GOTO1212
      IF(1.25.LT.PHEIG2.AND.PHEIG2.LE.1.75)GOTO1213
      GOTO1214
C
 1211 CONTINUE
      JSIZE=1
      PWIDPP=0.776*RATIV1
      PHOGPP=0.212*RATIV1
      PHEIPP=0.987*RATIV1
      PVEGPP=0.564*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=0.776*RATIVH
      PHOGA2=0.212*RATIVH
      PHEIG2=0.987
      PVEGA2=0.564
      GOTO9000
C
 1212 CONTINUE
      JSIZE=2
      PWIDPP=0.856*RATIV1
      PHOGPP=0.233*RATIV1
      PHEIPP=1.089*RATIV1
      PVEGPP=0.623*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=0.856*RATIVH
      PHOGA2=0.233*RATIVH
      PHEIG2=1.089
      PVEGA2=0.623
      GOTO9000
C
 1213 CONTINUE
      JSIZE=3
      PWIDPP=1.283*RATIV1
      PHOGPP=0.350*RATIV1
      PHEIPP=1.633*RATIV1
      PVEGPP=0.933*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=1.283*RATIVH
      PHOGA2=0.350*RATIVH
      PHEIG2=1.633
      PVEGA2=0.933
      GOTO9000
C
 1214 CONTINUE
      JSIZE=4
      PWIDPP=1.410*RATIV1
      PHOGPP=0.385*RATIV1
      PHEIPP=1.795*RATIV1
      PVEGPP=1.026*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=1.410*RATIVH
      PHOGA2=0.385*RATIVH
      PHEIG2=1.795
      PVEGA2=1.026
      GOTO9000
C
C               **************************************************************
C               **  STEP 13--                                               **
C               **  TREAT THE TEKTRONIX 402X CASES                          **
C               **  REFERENCE--IGL MANUAL, PAGE 6-22
C               **************************************************************
C
 1300 CONTINUE
      JSIZE=1
      PWIDPP=1.667*RATIV1
      PHOGPP=0.238*RATIV1
      PHEIPP=2.143*RATIV1
      PVEGPP=1.190*RATIV1
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=1.667*RATIVH
      PHOGA2=0.238*RATIVH
      PHEIG2=2.143
      PVEGA2=1.190
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               ******************************************************
C
 2200 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
C               ******************************************************
C
 2300 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE HEWLETT-PACKARD PCL   CASES           **
C               **  HP LASERJET PRINTERS                            **
C               **  SIZE DETERMINED BY THE FONT BEING USED          **
C               **  PCL FONTS USE POINT SIZE.  (POINT=1/72IN)       **
C               **  CURRENTLY, ONLY THE 3 INTERNAL FONTS ARE        **
C               **  SUPPORTED.  NOTE THAT THESE ARE ALL FIXED SPACE **
C               **  FONTS.
C               ******************************************************
C
 2600 CONTINUE
      PPI=PCLPPI
      JSIZE=2
      IF(IPCLFN.EQ.'CMED')JSIZE=2
      IF(IPCLFN.EQ.'CBOL')JSIZE=2
      IF(IPCLFN.EQ.'COND')JSIZE=1
      IF(JSIZE.EQ.2)GOTO2610
C
      APOINT=8.5
      ACPI=16.66
      GOTO2619
 2610 CONTINUE
      APOINT=12.
      ACPI=10.
      GOTO2619
C
 2619 CONTINUE
      PHEIPP=(APOINT/72.)*PPI
      PVEGPP=0.
      PWIDPP=PPI/ACPI
      PHOGPP=0.
      JHEIGH2=PHEIPP+0.5
      JVEGA2=0
      JWIDT2=PWIDPP+0.5
      JHOGA2=0
      PHEIG2=PHEIPP*100./ANUMVP
      PVEGA2=0.
      PWIDT2=PWIDPP*100./ANUMHP
      PHOGA2=0.
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      GOTO9000
C
C               *******************************************************
C               **  STEP 33--                                        **
C               **  TREAT THE CGM CASE                               **
C               *******************************************************
C
 3300 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               **  THE DEFAULT WIDTH OF A CALCOMP CHARACTER IS THE **
C               **  SAME AS THE HEIGHT (BUT WIDTH = CHARACTER PLUS  **
C               **  SPACING WHILE HEIGHT = CHARACTER ONLY).  THERE IS*
C               **  "SETCHR" CALL FOR SOME CALCOMP PLOTTERS THAT    **
C               **  ALLOWS THE ASPECT RATIO TO BE SET, BUT NOT      **
C               **  IMPLEMENTED HERE SINCE NOT SUPPORTED BY ALL     **
C               **  CALCOMP PLOTTERS (PARTICULARLY EMULATION PACKAGES*
C               ******************************************************
C
 4100 CONTINUE
      PWIDPP=RATIV1*PWIDT2
      PWIDT2=PHEIG2*RATIVH
      PHOGPP=0.
      PHEIPP=RATIV1*PHEIG2
      PVEGPP=0.0
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PHOGA2=0.0
      PVEGA2=0.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      PWIDPP=RATIV1*PWIDT2
      PWIDT2=PHEIG2*RATIVH
      PHOGPP=0.
      PHEIPP=RATIV1*PHEIG2
      PVEGPP=0.0
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PHOGA2=0.0
      PVEGA2=0.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      PHEIPP=ANUMVP*PHEIG2/100.
      PVEGPP=ANUMVP*PVEGA2/100.
      PWIDPP=PHEIPP*0.6
      PHOGPP=PVEGPP*0.6
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      PHEIG2=REAL(JHEIG2)*100./ANUMVP
      PVEGA2=REAL(JVEGA2)*100./ANUMVP
      PWIDT2=REAL(JWIDT2)*100./ANUMVP
      PHOGA2=REAL(JHOGA2)*100./ANUMVP
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      PWIDPP=0.0
      PHOGPP=0.0
      PHEIPP=0.0
      PVEGPP=0.0
      JWIDT2=0
      JHOGA2=0
      JHEIG2=0
      JVEGA2=0
      PHEIG2=(25.0/100.0)*PHEIG2
      PWIDT2=(75.0/100.0)*PWIDT2
      PHOGA2=0.0
      PVEGA2=0.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      PWIDPP=0.0
      PHOGPP=0.0
      PHEIPP=0.0
      PVEGPP=0.0
      JWIDT2=0
      JHOGA2=0
      JHEIG2=0
      JVEGA2=0
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               **  NOTE: ZETA LIBRARY HAS ASPECT RATIO TO CONTROL  **
C               **             WIDTH/HEIGHT RATIO.  THE WIDTH       **
C               **             INCLUDES BOTH THE CHARACTER WIDTH AND**
C               **             THE INTERCHARACTER SPACING WHILE THE **
C               **             HEIGHT ONLY INCLUDES THE CHARACTER.  **
C               **             ALSO, BASE THE WIDTH ON THE VERTICAL **
C               **             AXIS (FOR CONSISTENCY) AND THEN      **
C               **             RECALCULATE PWIDT2 (BASED ON         **
C               **             HORIZONTAL SIZE)                     **
C               ******************************************************
C
 5100 CONTINUE
      PTEMP=PWIDT2+PHOGA2
      PRATIO=PTEMP/PHEIG2
CCCCC CALL ASPECT(PRATIO)
      PWIDPP=PTEMP*RATIV1
      PHOGPP=0.
      PHEIPP=RATIV1*PHEIG2
      PVEGPP=0.0
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=PTEMP*RATIVH
      PHOGA2=0.
      PVEGA2=0.
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE                              **
C               ******************************************************
C
 6600 CONTINUE
      PWIDPP=0.50*RATIV1*PHEIG2
      PHOGPP=0.214*RATIV1*PHEIG2
      PHEIPP=1.000*RATIV1*PHEIG2
      PVEGPP=0.750*RATIV1*PHEIG2
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=0.50*RATIVH*PHEIG2
      PHOGA2=0.214*RATIVH*PHEIG2
      PVEGA2=0.750*PHEIG2
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS          CASE                   **
C               ******************************************************
C
C  MARCH, 1991.  HANDLE VARIOUS CHARACTER SIZES CORRECTLY.
C
C  THE SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8
C  PIXELS.  THIS STANDARD SIZE MAY BE SCALED UP BY
C  FACTORS OF 1, 2, ..., UP TO 10.  THE DISPLAY CELL
C  SIZE IS THE SIZE OF THE CHARACTER CELL (CHARACTER
C  + MARGIN), WHILE THE UNIT CELL SIZE IS THE SIZE OF
C  THE CHARACTER ONLY.  THE DIFFERENCE BETWEEN THEM
C  DEFINES THE HORIZONTAL GAP.  NOTE THAT THE
C  VERTICAL GAP IS BUILT INTO THE CHARACTER ITSELF
C  (I.E., PVEGA2=0.).  THE FOLLOWING TABLE GIVES THE
C  AVAILABLE CHARACTER SIZES:
 
C  SET NUMBER         CELL SIZE          CHARACTER SIZE
C    (JSIZE)       WIDTH BY HEIGHT       WIDTH BY HEIGHT
 
C  0      GET FROM ALAN
C  1                      [  9, 20]                [  8, 20]
C  2                      [ 18, 30]                [ 16, 30]
C  3                      [ 27, 45]                [ 24, 45]
C  4                      [ 36, 60]                [ 32, 60]
C  5                      [ 45, 75]                [ 40, 75]
C  6                      [ 54, 90]                [ 48, 90]
C  7                      [ 63,105]                [ 56,105]
C  8                      [ 72,120]                [ 64,120]
C  9                      [ 81,135]                [ 72,135]
C 10                      [ 90,150]                [ 90,150]
C 11                      [ 99,165]                [ 88,165]
C 12                      [108,180]                [ 96,180]
C 13                      [117,195]                [104,195]
C 14                      [126,210]                [112,210]
C 15                      [135,225]                [120,225]
C 16                      [144,240]                [128,240]
C
C  RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS
C  REQUESTED).  THIS SIZE WILL BE ROUNDED TO THE
C  CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE.
 
C
 8100 CONTINUE
      ATEMP=PHEIG2*RATIV1
      IF(ATEMP.LE.15.0)THEN
        JSIZE=0
        PWIDPP=8.0
        PHOGPP=1.0
        PHEIPP=10.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.25.0)THEN
        JSIZE=1
        PWIDPP=8.0
        PHOGPP=1.0
        PHEIPP=20.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.37.5)THEN
        JSIZE=2
        PWIDPP=16.0
        PHOGPP=2.0
        PHEIPP=30.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.52.5)THEN
        JSIZE=3
        PWIDPP=24.0
        PHOGPP=3.0
        PHEIPP=45.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.67.5)THEN
        JSIZE=4
        PWIDPP=32.0
        PHOGPP=4.0
        PHEIPP=60.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.82.5)THEN
        JSIZE=5
        PWIDPP=40.0
        PHOGPP=5.0
        PHEIPP=75.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.97.5)THEN
        JSIZE=6
        PWIDPP=48.0
        PHOGPP=6.0
        PHEIPP=90.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.112.5)THEN
        JSIZE=7
        PWIDPP=56.0
        PHOGPP=7.0
        PHEIPP=105.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.127.5)THEN
        JSIZE=8
        PWIDPP=64.0
        PHOGPP=8.0
        PHEIPP=120.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.142.5)THEN
        JSIZE=9
        PWIDPP=72.0
        PHOGPP=9.0
        PHEIPP=135.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.157.5)THEN
        JSIZE=10
        PWIDPP=80.0
        PHOGPP=10.0
        PHEIPP=150.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.172.5)THEN
        JSIZE=11
        PWIDPP=88.0
        PHOGPP=11.0
        PHEIPP=165.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.187.5)THEN
        JSIZE=12
        PWIDPP=96.0
        PHOGPP=12.0
        PHEIPP=180.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.202.5)THEN
        JSIZE=13
        PWIDPP=104.0
        PHOGPP=13.0
        PHEIPP=195.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.217.5)THEN
        JSIZE=14
        PWIDPP=112.0
        PHOGPP=14.0
        PHEIPP=210.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.232.5)THEN
        JSIZE=15
        PWIDPP=120.0
        PHOGPP=15.0
        PHEIPP=225.0
        PVEGPP=0.0
      ELSE
        JSIZE=16
        PWIDPP=128.0
        PHOGPP=16.0
        PHEIPP=240.0
        PVEGPP=0.0
      END IF
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=(PWIDPP/ANUMHP)*100.0
      PHOGA2=(PHOGPP/ANUMHP)*100.0
      PHEIG2=(PHEIPP/ANUMVP)*100.0
      PVEGA2=0.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT            CASES           **
C               **  SIZE IS IN POSTSCRIPT UNITS (1/72 = 1 POINT BY  **
C               **  DEFAULT).  DATAPLOT SCALES UNITS BY POINTS PER  **
C               **  INCH, SO 1 UNIT IS (1/POINTS PER INCH) = 1 PIXEL**
C               **  FOR DATAPLOT.                                   **
C               **  NOTE THAT POSTSCRIPT FONTS ARE PROPORTIONALLY   **
C               **  SPACED, SO USE 0.6 OF HEIGHT AS DUMMY VALUE.    **
C               ******************************************************
C
 8600 CONTINUE
      PPI=PSTPPI
      PHEIPP=ANUMVP*PHEIG2/100.
      PVEGPP=ANUMVP*PVEGA2/100.
      PWIDPP=PHEIPP*0.6
      PHOGPP=PVEGPP*0.6
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      PHEIG2=REAL(JHEIG2)*100./ANUMVP
      PVEGA2=REAL(JVEGA2)*100./ANUMVP
      PWIDT2=REAL(JWIDT2)*100./ANUMVP
      PHOGA2=REAL(JHOGA2)*100./ANUMVP
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC                  CASES           **
C               **  QMS AND TALARIS LASER PRINTERS                  **
C               **  SIZE DETERMINED BY THE FONT BEING USED          **
C               **  QUIC FONTS USE POINT SIZE.  (POINT=1/72IN)      **
C               **  10   - EDP FONT, 8 POINT, 14 CPI (21 DOT/CHAR)  **
C               **         LANDSCAPE, PORTRAIT                      **
C               **  104  - STANDARD ROMAN MEDIUM, 10 POINT, PROPORT.**
C               **         LANDSCAPE, PORTRAIT                      **
C               **  124  - STANDARD ROMAN BOLD, 10 POINT, PROPORT.  **
C               **                    PORTRAIT                      **
C               **  144  - STANDARD ROMAN ITALIC, 10 POINT, PROPORT.**
C               **                    PORTRAIT                      **
C               **  16   - SIMPLEX ROMAN, 5 POINT PROPORTIONAL      **
C               **                    PORTRAIT                      **
C               **  204  - APOLLO MEDIUM, 10 POINT, PROPORTIONAL    **
C               **         LANDSCAPE, PORTRAIT                      **
C               **  328  - COMPLEX ROMAN BOLD, PROPORTIONAL 15 POINT**
C               **                    PORTRAIT                      **
C               **  404  - Q-TYPEWRITER, 10 POINT, (30 DOT/CHAR)    **
C               **                    PORTRAIT                      **
C               **  444  - Q-TYPEWRITER ITALIC, 30 DOTS WIDE        **
C               **                    PORTRAIT                      **
C               **  NOTE: THE ABOVE ARE "HARDWARE" FONTS.  THE      **
C               **        FOLLOWING ARE "DOWNLOADABLE" FONTS THAT   **
C               **        MAY NOT BE AVAILABLE ON A GIVEN MACHINE   **
C               **                                                  **
C               **  521  - TEKTRONIX SMALL, 12 CPI (25 DOT/CHAR) 8.0 POINT
C               **         LANDSCAPE                                **
C               **  522  - TEKTRONIX MEDIU, 10 CPI (30 DOT/CHAR)10.3 POINT
C               **         LANDSCAPE                                **
C               **  523  - TEKTRONIX BIG,  7.9 CPI (38 DOT/CHAR)12.3 POINT
C               **         LANDSCAPE                                **
C               **  524  - TEKTRONIX XBIG, 7.3 CPI (41 DOT/CHAR)13.7 POINT
C               **         LANDSCAPE                                **
C               **  532  - UNION 10 POINT, 12 CPI (25 DOTS/CHAR)    **
C               **                    PORTRAIT                      **
C               **  517  - Q-GREEK 10 POINT, 10 CPI (30 DOTS/CHAR)  **
C               **         LANDSCAPE, PORTRAIT                      **
C               **  536  - Q-GREEK 10 POINT, 12 CPI (25 DOTS/CHAR)  **
C               **         LANDSCAPE, PORTRAIT                      **
C               **  904  - Q-GOTHIC 10 POINT, 12 CPI (25 DOTS/CHAR) **
C               **         LANDSCAPE, PORTRAIT                      **
C               **  924  - Q-GOTHIC ITALIC, 10 POINT, 12 CPI (25 DOTS)
C               **         LANDSCAPE, PORTRAIT                      **
C               **  IF THE REQUESTED FONT IS NOT AVAILABLE IN THE   **
C               **  GIVEN ORIENTATION (LANDSCAPE OR PORTRAIT), THE  **
C               **  EDP FONT WILL BE USED (BUT VALUE OF IQUIFN NOT  **
C               **  MODIFIED).                                      **
C               **  THE CPI GIVEN FOR THE PROPORTIONAL FONTSIS JUST **
C               **  A GUIDE, TABLES ARE USED TO FIND LENGTH OF STRING*
C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
C               **             APPENDIX B                           **
C               ******************************************************
C
 9100 CONTINUE
      PPI=QUIPPI
      IFONTT=IQUIFN
      IF(IORNSW.EQ.'PORT'.AND.(
     1IFONTT.EQ.521.OR.
     1IFONTT.EQ.522.OR.
     1IFONTT.EQ.523.OR.
     1IFONTT.EQ.524))IFONTT=10
      IF(IORNSW.NE.'PORT'.AND.(
     1IFONTT.EQ.124.OR.
     1IFONTT.EQ.144.OR.
     1IFONTT.EQ.16.OR.
     1IFONTT.EQ.328.OR.
     1IFONTT.EQ.998.OR.
     1IFONTT.EQ.404.OR.
     1IFONTT.EQ.444.OR.
     1IFONTT.EQ.532))IFONTT=10
      IF(IFONTT.EQ.16) THEN
        APOINT=5.0
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.10) THEN
        APOINT=8.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.104)THEN
        APOINT=10.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.124)THEN
        APOINT=10.
         AWIDTH=21.
      ELSE IF(IFONTT.EQ.144)THEN
        APOINT=10.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.204)THEN
        APOINT=10.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.404)THEN
        APOINT=10.
         AWIDTH=30.
      ELSE IF(IFONTT.EQ.444)THEN
        APOINT=10.
        AWIDTH=30.
      ELSE IF(IFONTT.EQ.328)THEN
        APOINT=15.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.998)THEN
        APOINT=15.
        AWIDTH=21.
      ELSE IF(IFONTT.EQ.521)THEN
        APOINT=8.
        AWIDTH=25.
      ELSE IF(IFONTT.EQ.522)THEN
        APOINT=10.3
        AWIDTH=30.
      ELSE IF(IFONTT.EQ.523)THEN
        APOINT=12.3
        AWIDTH=38.
      ELSE IF(IFONTT.EQ.524)THEN
        APOINT=13.7
        AWIDTH=41.
      ELSE IF(IFONTT.EQ.532)THEN
        APOINT=10.
        AWIDTH=25.
      ELSE IF(IFONTT.EQ.517)THEN
        APOINT=10.
        AWIDTH=30.
      ELSE IF(IFONTT.EQ.536)THEN
        APOINT=10.
        AWIDTH=25.
      ELSE IF(IFONTT.EQ.664)THEN
        APOINT=10.
        AWIDTH=25.
      ELSE IF(IFONTT.EQ.904)THEN
        APOINT=10.
        AWIDTH=25.
      ELSE IF(IFONTT.EQ.924)THEN
        APOINT=10.
        AWIDTH=25.
      ELSE
        APOINT=8.
        AWIDTH=21.
        IFONTT=10
      END IF
      PHEIPP=(APOINT/72.)*PPI
      PVEGPP=0.
      PWIDPP=AWIDTH
      PHOGPP=0.
      JHEIG2=PHEIPP+0.5
      JVEGA2=0
      JWIDT2=PWIDPP+0.5
      JHOGA2=0
      PHEIG2=PHEIPP*100./ANUMVP
      PVEGA2=0.
      PWIDT2=PWIDPP*100./ANUMHP
      PHOGA2=0.
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11            CASE                   **
C               **  THE UNDERLYING C LIBRARY WILL HANDLE CHARACTER  **
C               **  SIZE, JUSTIFICATION, AND POSITIONING VIA XLIB   **
C               **  CALLS.  THEREFORE, THIS IS A NULL ROUTINE.      **
C               ******************************************************
C
 9600 CONTINUE
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 93.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 327.                       **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS
C               **             USING TURBO C, PAGE 52.         **
C               *************************************************
C
C  THE CELL SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8
C  PIXELS.  THIS STANDARD SIZE MAY BE SCALED UP BY
C  FACTORS OF 1, 2, ..., UP TO 10.  THE CELL SIZE IS
C  THE SIZE OF THE CHARACTER + MARGIN.  THE CHARACTER
C  SIZE IS THE SIZE OF THE CHARACTER ONLY.  NOTE THAT
C  THE VERTICAL GAP AND HORIZONTAL GAP IS BUILT INTO   ?????
C  THE CHARACTER ONLY (I.E., PVEGA2 = PHOGA2 = 0).
C  THE FOLLOWING TABLE GIVES THE AVAILABLE CHARACTER
C  SIZES:
 
C  SET NUMBER         CELL SIZE          CHARACTER SIZE
C    (JSIZE)       HEIGHT BY WIDTH       HEIGHT BY WIDTH
C   1                   8,8                    7,7
C   2                  16,16                  14,14
C   3                  24,24                  21,21
C   4                  32,32                  28,28
C   5                  40,40                  35,35
C   6                  48,48                  42,42
C   7                  56,56                  49,49
C   8                  64,64                  56,56
C   9                  72,72                  63,63
C  10                  80,80                  70,70
C
C  RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS
C  REQUESTED).  THIS SIZE WILL BE ROUNDED TO THE
C  CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE.
C
10000 CONTINUE
      ATEMP=PHEIG2*RATIV1
      IF(ATEMP.LE.12.0)THEN
        JSIZE=1
        PWIDPP=8.0
        PHOGPP=0.0
        PHEIPP=8.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.20.0)THEN
        JSIZE=2
        PWIDPP=16.0
        PHOGPP=0.0
        PHEIPP=16.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.28.0)THEN
        JSIZE=3
        PWIDPP=24.0
        PHOGPP=0.0
        PHEIPP=24.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.36.0)THEN
        JSIZE=4
        PWIDPP=32.0
        PHOGPP=0.0
        PHEIPP=32.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.44.0)THEN
        JSIZE=5
        PWIDPP=40.0
        PHOGPP=0.0
        PHEIPP=40.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.52.0)THEN
        JSIZE=6
        PWIDPP=48.0
        PHOGPP=0.0
        PHEIPP=48.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.60.0)THEN
        JSIZE=7
        PWIDPP=56.0
        PHOGPP=0.0
        PHEIPP=56.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.68.0)THEN
        JSIZE=8
        PWIDPP=64.0
        PHOGPP=0.0
        PHEIPP=64.0
        PVEGPP=0.0
      ELSE IF(ATEMP.LE.76.0)THEN
        JSIZE=9
        PWIDPP=72.0
        PHOGPP=0.0
        PHEIPP=72.0
        PVEGPP=0.0
      ELSE
        JSIZE=10
        PWIDPP=80.0
        PHOGPP=0.0
        PHEIPP=80.0
        PVEGPP=0.0
      END IF
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PWIDT2=(PWIDPP/ANUMHP)*100.0
      PHOGA2=0.0
      PHEIG2=(PHEIPP/ANUMVP)*100.0
      PVEGA2=0.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      PHEIPP=ANUMVP*PHEIG2/100.
      PVEGPP=ANUMVP*PVEGA2/100.
      PWIDPP=PHEIPP*0.6
      PHOGPP=PVEGPP*0.6
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      PHEIG2=REAL(JHEIG2)
      PVEGA2=REAL(JVEGA2)
      PWIDT2=REAL(JWIDT2)
      PHOGA2=REAL(JHOGA2)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
C  LATEX SUPPORTS 10 SIZES.  NOTE THAT THE SPECIFIC SIZE USED WILL
C  DEPEND ON THE FONT SELECTED AND THE DEFAULT DOCUMENT POINT SIZE.
C  THE FOLLOWING POINT SIZES ARE BASED ON THE DEFAULT CMR FONT AND
C  A DEFAULT DOCUMENT SIZE OF 12PT.
C
C  WE ARE USING A 300DPI COORDINATE SCALE AND THERE ARE 72 POINTS PER INCH.
C  THIS IMPLIES 4.16 PIXELS PER POINT (APPROXIMATELY).
C
C    1. \tiny          =  6 POINT  = 25 PIXELS
C    2. \scriptsize    =  8 POINT  = 33 PIXELS
C    3. \footnotesize  = 10 POINT  = 42 PIXELS
C    4. \small         = 10 POINT  = 42 PIXELS
C    5. \normalsize    = 12 POINT  = 50 PIXELS
C    6. \large         = 12 POINT  = 50 PIXELS
C    7. \Large         = 17 POINT  = 71 PIXELS
C    8. \LARGE         = 17 POINT  = 71 PIXELS
C    9. \huge          = 17 POINT  = 71 PIXELS
C   10. \Huge          = 17 POINT  = 71 PIXELS
C
C
15000 CONTINUE
      PHEIPP=ANUMVP*PHEIG2/100.
      IF(PHEIPP.LE.29.0)THEN
        JSIZE=1
        APNT=6.0
      ELSEIF(PHEIPP.LE.37.0)THEN
        JSIZE=2
        APNT=8.0
      ELSEIF(PHEIPP.LE.42.0)THEN
        JSIZE=3
        APNT=10.0
      ELSEIF(PHEIPP.LE.46.0)THEN
        JSIZE=4
        APNT=10.0
      ELSEIF(PHEIPP.LE.58.0)THEN
        JSIZE=5
        APNT=12.0
      ELSEIF(PHEIPP.LE.70.0)THEN
        JSIZE=6
        APNT=12.0
      ELSEIF(PHEIPP.LE.75.0)THEN
        JSIZE=7
        APNT=17.0
      ELSEIF(PHEIPP.LE.80.0)THEN
        JSIZE=8
        APNT=17.0
      ELSEIF(PHEIPP.LE.85.0)THEN
        JSIZE=9
        APNT=17.0
      ELSE
        JSIZE=10
        APNT=17.0
      ENDIF
      PHEIPP=APNT*4.16
      PVEGPP=0.0
      PWIDPP=PHEIPP*0.6
      PHOGPP=0.0
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      PWIDT2=(PWIDPP/ANUMHP)*100.0
      PHOGA2=0.0
      PHEIG2=0.75*(PHEIPP/ANUMVP)*100.0
      PVEGA2=0.25*(PHEIPP/ANUMVP)*100.0
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      PWIDPP=RATIV1*PWIDT2
      PWIDT2=PHEIG2*RATIVH
      PHOGPP=0.
      PHEIPP=RATIV1*PHEIG2
      PVEGPP=0.0
      JWIDT2=PWIDPP+0.5
      JHOGA2=PHOGPP+0.5
      JHEIG2=PHEIPP+0.5
      JVEGA2=PVEGPP+0.5
      PHOGA2=0.0
      PVEGA2=0.0
      GOTO9000
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRSI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE,IFONT
 9012 FORMAT('ICASE,IFONT = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9013 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)JSIZE
 9014 FORMAT('JSIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)JHEIG2,JWIDT2,JVEGA2,JHOGA2
 9015 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9016 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PHEIPP,PWIDPP,PVEGPP,PHOGPP
 9017 FORMAT('PHEIPP,PWIDPP,PVEGPP,PHOGPP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IMANUF,IMODEL
 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4
 9019 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRTH(ICASE,PTHICK,JTHICK,PTHIC2)
C
C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
C              TRANSLATE A DESIRED LINE THICKNESS (IN PTHICK)
C              GIVEN IN (0.0 TO 100.0) REPRESENTATION
C              INTO AN INTEGER NUMERIC REPRESENTATION (IN JTHICK)
C              THAT WILL BE UNDERSTOOD BY THE SPECIFIC
C              GRAPHICS DEVICE BEING USED.
C              ALSO, CREATE A SECOND VARIABLE (PTHIC2) WHICH CONTAINS
C              THE CLOSEST ALLOWABLE LINE THICKNESS VALUE
C              (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON
C              THE TEKTRONIX GRAPHICS DEVICE BEING USED.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD, CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
      CHARACTER*4 ICASE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASE
   52 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PTHICK
   53 FORMAT('PTHICK = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IMANUF,IMODEL
   54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ************************************************
C               **  STEP 0--                                  **
C               **  DEFINE THICKNESS                          **
C               **  FOR A GENERAL GRAPHICS DEVICE             **
C               **  THICKNESS WILL BE SET IN                  **
C               **  HARDWARE IF THE DEVICE SUPPORTS           **
C               **  THIS CAPABILITY.  OTHERWISE THE           **
C               **  FOLLOWING ALGORITHIM IS USED.             **
C               **  1)  DRAW A LINE WITH THE REQUESETED COORD.**
C               **  2)  PDELTA=(PTHICK/PDEVTH)/2.             **
C               **  3)  AINC  = PDELTA/PDEVTH                 **
C               **  4)  NINC  = AINC+0.9                      **
C               **  5)  JTHICK=NINC                           **
C               **      PTHIC2=PDELTA/REAL(NINC)              **
C               **  WHERE                                     **
C               **      PTHICK IS THE USER REQUESTED THICKNESS**
C               **      PDEVTH IS ONE LINE THICKNESS FOR A    **
C               **             SPECIFIC DEVICE.               **
C               **      "DPDRPL" WILL DRAW THE MIDDLE LINE.   **
C               **      IT THEN SPLITS THE REMAINING THICKNESS**
C               **      INTO AN "ABOVE" AND "BELOW" PART.     **
C               **      NINC IS THE NUMBER OF ADDITIONAL LINES**
C               **      REQUIRED (BOTH ABOVE AND BELOW THE    **
C               **      INITIAL LINE).  THE DISTANCE IS THEN  **
C               **      DIVIDED BY NINC TO GET THE "DELTA"    **
C               **      USED BY "DPDRPL", I.E., THE AMOUNT    **
C               **      ADDED TO THE COORDINATES TO DRAW THE  **
C               **      NEXT LINE.  THE 0.9 IS "FUDGE FACTOR".**
C               **      FOR EXAMPLE, ON A TEKTRONIX WITH A    **
C               **      LINE THICKNESS OF 0.1, A USER REQUESTED*
C               **      THICKNESS OF 0.12 IS REQUIRED BEFORE  **
C               **      ADDITIONAL LINES WILL BE DRAWN.       **
C               ************************************************
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX CASE                        **
C               ******************************************************
C
 1100 CONTINUE
C
      PPENTH=PTEKTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO1190
 1110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 1190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX.                             **
C               ******************************************************
C
 2100 CONTINUE
C
      PPENTH=P722TH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO2190
 2110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 2190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE XX, XXX.                        **
C               ******************************************************
C
 2200 CONTINUE
C
      PPENTH=PHPGTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO2290
 2210 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 2290 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
C               ******************************************************
C
 2300 CONTINUE
C
      PPENTH=P262TH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO2310
      JTHICK=0
      PTHIC2=PTHICK
      GOTO2390
 2310 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 2390 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE PCL       CASE                        **
C               ******************************************************
C
 2600 CONTINUE
C
C  PTHIC2 WILL BE THE NUMBER OF "PIXELS" WIDE TO DRAW THE LINE
C  SHOULD BE ODD INTEGER
C
      JTHICK=0
      ATEMP=PTHICK*ANUMVP/100.
      ITEMP=ATEMP+0.5
      IF(MOD(ITEMP,2).EQ.0)ITEMP=ITEMP+1
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.50)ITEMP=50
      PTHIC2=REAL(ITEMP)
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               **  2 CASES: LET THE POST-PROCESSOR DO THE LINE     **
C               **           THICKNESS (IPTHSW='OFF') OR HAVE       **
C               **           DATAPLOT DO BY DRAWING MULTIPLE LINES  **
C               **           IF DATAPLOT DOES IT, THE LINE THICKNESS**
C               **           IS TAKEN FROM (PPENSW).                **
C               ******************************************************
C
 3100 CONTINUE
      IF(IPTHSW.EQ.'ON')GOTO3120
      PTHIC2=PTHICK
      JTHICK=0
      GOTO3190
C
 3120 CONTINUE
      PPENTH=PPENSW
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO3160
      JTHICK=0
      PTHIC2=PTHICK
      GOTO3190
 3160 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
C
 3190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
      PPENTH=PCALTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO4190
 4110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 4190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      PPENTH=PLAHTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4610
      JTHICK=0
      PTHIC2=PTHICK
      GOTO4690
 4610 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 4690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      PPENTH=100.*(1./ANUMVP)
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4710
      JTHICK=0
      PTHIC2=PTHICK
      GOTO4790
 4710 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
 4790 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      PPENTH=100.*(1./ANUMVP)
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4910
      JTHICK=0
      PTHIC2=PTHICK
      GOTO4940
 4910 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
 4940 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      PPENTH=100.*(1./ANUMVP)
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4960
      JTHICK=0
      PTHIC2=PTHICK
      GOTO4990
 4960 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
 4990 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 AND B-1                    **
C               ******************************************************
C
 5100 CONTINUE
      PPENTH=PZETTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO5110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO5190
 5110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 5190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
      PPENTH=0.1
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO6190
 6110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 6190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN       CASE                        **
C               ******************************************************
C
 6600 CONTINUE
C
      PPENTH=PSUNTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO6610
      JTHICK=0
      PTHIC2=PTHICK
      GOTO6690
 6610 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 6690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
      PPENTH=0.1
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO7110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO7190
 7110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 7190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE REGIS     CASE                        **
C               ******************************************************
C
 8100 CONTINUE
C
      PPENTH=PREGTH
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO8110
      JTHICK=0
      PTHIC2=PTHICK
      GOTO8190
 8110 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
 8190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               ******************************************************
C
 8600 CONTINUE
C
C  THE POSTSCRIPT PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET
C  IN USER COORDINATES.  BASE THE THICKNESS ON THE VERTICAL SIZE.
C  TYPICALLY, 8.5*300.  UNLIKE THE QUIC PROTOCOL, POSTSCRIPT SUPPORTS
C  RESOLUTIONS OTHER THAN 300 DPI, SO DO NOT "HARD CODE" AS IN THE
C  QUIC CASE.
C  PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE.
C  (PTHICK/100.)=(PIXELS/(ANUMVP)) IMPLIES PIXELS=PTHICK*ANUMVP/100.
C
      ATEMP=PTHICK*ANUMVP/100.
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.50)ITEMP=50
      PTHIC2=REAL(ITEMP)
      JTHICK=0
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC      CASE                        **
C               ******************************************************
C
 9100 CONTINUE
C
C  THE QUIC PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET FROM
C  1 TO 31 PIXELS WIDE.  BASE THE THICKNESS ON 8.5 INCHES HEIGHT
C  (X300=2,550 PIXELS).  THIS WAY, LINE THICKNESS WILL NOT DEPEND
C  ON WHETHER LANDSCAPE OR PORTRAIT MODE IN EFFECT.
C  JTHICK IS THE NUMBER OF LOOPS TO DRAW THICKER LINES, SO SET TO 0.
C  PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE.
C  (PTHICK/100.)=(PIXELS/(8.5*300)) IMPLIES PIXELS=PTHICK*(8.5*300)/100.
C                                                 =PTHICK*25.5
C  NOTE: PIXELS GO IN ODD INCREMENTS ONLY, I.E., 1,3,5,7, .. ,31.
C
      ATEMP=PTHICK*25.5
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.31)ITEMP=31
      PTHIC2=REAL(ITEMP)
      IJUNK=MOD(INT(PTHIC2),2)
      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
      JTHICK=0
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  BASE THICKNESS ON "1000" POINTS SO THAT NUMBER  **
C               **  OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE **
C               **  PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION **
C               **  PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE **
C               **  LINE.                                           **
C               ******************************************************
C
 9600 CONTINUE
      ATEMP=PTHICK*(1000.)/100.
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.15)ITEMP=15
      PTHIC2=REAL(ITEMP)
      IJUNK=MOD(ITEMP,2)
      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
      JTHICK=0
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 83.          **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 321.                       **
C               *************************************************
C
10000 CONTINUE
C
      ATEMP=PTHICK*ANUMVP/100.
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.3)ITEMP=3
      PTHIC2=REAL(ITEMP)
      IJUNK=MOD(ITEMP,2)
      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
      JTHICK=0
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
CCCCC PPENTH=PTEKTH
      PPENTH=0.1
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO11010
      JTHICK=0
      PTHIC2=PTHICK
      GOTO1190
11010 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
11090 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  BASE THICKNESS ON "1000" POINTS SO THAT NUMBER  **
C               **  OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE **
C               **  PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION **
C               **  PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE **
C               **  LINE.                                           **
C               ******************************************************
C
12000 CONTINUE
      PPENTH=100.*(1./ANUMVP)
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO12960
      JTHICK=0
      PTHIC2=PTHICK
      GOTO12990
12960 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
12990 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      PPENTH=100.*(1./ANUMVP)
      PDELTA=(PTHICK-PPENTH)/2.
      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO13560
      JTHICK=0
      PTHIC2=PTHICK
      GOTO13590
13560 CONTINUE
      AINC=PDELTA/PPENTH
      NINC=AINC+0.9
      JTHICK=NINC
      PTHIC2=PTHICK
      IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
13590 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      ATEMP=PTHICK*ANUMVP/100.
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.50)ITEMP=50
      PTHIC2=REAL(ITEMP)
      JTHICK=0
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      JTHICK=0
      IF(ILATLT.EQ.'HARD')THEN
        IF(PTHICK.GE.0.25)THEN
          PTHIC2=0.3
        ELSEIF(PTHICK.GE.0.15)THEN
          PTHIC2=0.2
        ELSE
          PTHIC2=0.1
        ENDIF
      ELSE
C
C       FOR LATEX, ASSUME SINGLE LINE WIDTH IS 1 POINT WIDE.
C       SINCE OUR COORDINATE SYSTEM IS SET TO 300 DPI (ONE
C       POINT IS 1/72 OF AN INCH), THIS TRANSLATES TO
C       ABOUT 4 PIXEL UNITS.
C
CCCCC   APIX=2.0
        APIX=2.0
        PPENTH=100.*(APIX/ANUMVP)
        PDELTA=(PTHICK-PPENTH)/2.
        IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)THEN
          AINC=PDELTA/PPENTH
          NINC=AINC+0.9
          JTHICK=NINC
          PTHIC2=PTHICK
          IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC)
        ELSE
          JTHICK=0
          PTHIC2=PTHICK
        ENDIF
      ENDIF
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
      ATEMP=PTHICK*ANUMVP/100.
      ITEMP=ATEMP+0.5
      IF(ITEMP.LT.1)ITEMP=1
      IF(ITEMP.GT.50)ITEMP=50
      PTHIC2=REAL(ITEMP)
      JTHICK=0
      GOTO9000
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASE
 9012 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PTHICK,JTHICK,PTHIC2
 9013 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IMANUF,IMODEL
 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRWRTH(PX1,PY1,ICTEXT,NCTEXT,
     1IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1PX99,PY99)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              AND FOR THE STANDARD (HARDWARE-GENERATED) FONT,
C              GO TO THE POINT (PX1,PY1) AND WRITE OUT
C              THE TEXT STRING
C              (IN A HORIZONTAL DIRECTION)
C              CONTAINED IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF NCTEXT CHARACTERS.
C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
C           THAT IS, EACH IS 0.0 TO 100.0.
C     NOTE--THE SUBSECTION    RWIND    HAS BEEN EXTRACTED
C           OUT OF     PLOT CONTROL COMMON   .
C           THIS (AND GRWRTV) ARE THE ONLY SUBROUTINES WHERE
C           THIS SUB-EXTRACTION HAS BEEN DONE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MARCH     1986.
C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
C                                       DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --OCTOBER  1989.  RWIND CORRECTION (NELSON HSU)
C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
C     UPDATED         --JULY     1990.  PACK HP 2622 OUTPUT
C     UPDATED         --MARCH    1991.  PACK REGIS OUTPUT.  ALSO, REGIS
C                                       POSITIONS CHARACTER BELOW RATHER THAN
C                                       ABOVE CURRENT POSITION.
C     UPDATED         --MAY      1991.  RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991.  VGA/TURBOC DRIVER (JJF)
C                                       DRIVER OBSOLETE
C     UPDATED         --MAY      1991.  FIX POSTSCRIPT CHAR. INDICES.
C     UPDATED         --OCTOBER  1991.  POSTSCRIPT FONTS (ALAN)
C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
C                                       BAD C-SIDE MULTIPLOTTING (SCALING)
C     UPDATED         --JANUARY   1995. FIX FRONT END TIC LABEL JUST.
C     UPDATED         --SEPTEMBER 1995. RETROACTIVE JIM/ALAN MERGE
C     UPDATED         --SEPTEMBER 1995. FIX TURBO-C SECTION
C                             BAD C-SIDE MULTIPLOTTING (SCALING) (AGAIN)
C     UPDATED         --SEPTEMBER 1995. REFIX TURBO-C SECTION
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD, CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CCCCC FOLLOWING LINE FOR MICROSOFT FORTRAN  OCTOBER 1996
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF TYPE (XYCOORD) XY
CQWVF TYPE (FONTINFO) MSFONT
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C
      CHARACTER*4 ICTEXT
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
CCCCC JULY, 1996.  ADD FOLLOWING 2 LINES
      CHARACTER*4 IJUSTH
      CHARACTER*4 IJUSTV
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
C
      CHARACTER*4 IC4
      CHARACTER*1 IC
      CHARACTER*1 IC1
      CHARACTER*1 IC2
      CHARACTER*1 ICARAT
      CHARACTER*1 IQUOTE
      CHARACTER*2 ICJUNK
C
      CHARACTER*130 ICSTR
      CHARACTER*130 ICSTR2
      CHARACTER*130 ICSTR3
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 ICTEMP
C
      DIMENSION ICTEXT(*)
      DIMENSION IHOLL(33)
C FOLLOWING 2 LINES ADDED FOR X11 DRIVER
      INTEGER STRING(130)
      INTEGER IADE(80)
CCCCC FOLLOWING 3 LINES FOR LAHEY COMPILER ADDED JULY 1996.
      CHARACTER*40 CLAHEY
      REAL RLAHEY(7)
      INTEGER ILAHEY(9)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C     THE FOLLOWING CORRECTION WAS MADE NOVEMBER 1989
CCCCC COMMON /RWIND/
CCCCC1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
CCCCC1WWXMIN,WWXMAX,WWYMIN,WWYMAX
      COMMON /RWIND/
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PYZMAX,
     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XTEXTH, XTATTR
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='WRTH'
      ISUBRO=ISUBG4
C
      NCSTR=(-999)
      K=(-999)
C
      IC4='-999'
      IC='-'
      IC1='-'
      IC2='-'
C
      PXDEL=(-999.0)
      PYDEL=(-999.0)
C
      K=(-999)
      NCTEP2=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRWRTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PX1,PY1
   53 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCTEXT
   54 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT)
   55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)JSIZE
   56 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IGUNIT
   57 FORMAT('IGUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT,JPATT
   59 FORMAT('IPATT,JPATT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST,JJUST
   62 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR,JDIR
   63 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILL,JFILL
   65 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL,JCOL
   66 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
   71 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************
C               **  STEP XX--                           **
C               **  COMPUTE NEW START POINTS DEPENDING  **
C               **  ON THE JUSTIFICATION                **
C               ******************************************
C
CCCCC JULY, 1996.  ADD SETTINGS FOR IJUSTH, IJUSTV IN FOLLOWING BLOCK
      IJUSTH='LEFT'
      IJUSTV='BOTT'
C
      IF(IJUST.EQ.'LEFT')GOTO910
      IF(IJUST.EQ.'CENT')GOTO920
      IF(IJUST.EQ.'RIGH')GOTO930
C
      IF(IJUST.EQ.'LJUS')GOTO910
      IF(IJUST.EQ.'CJUS')GOTO920
      IF(IJUST.EQ.'RJUS')GOTO930
C
      IF(IJUST.EQ.'LEBO')GOTO910
      IF(IJUST.EQ.'CEBO')GOTO920
      IF(IJUST.EQ.'RIBO')GOTO930
C
      IF(IJUST.EQ.'LECE')GOTO940
      IF(IJUST.EQ.'CECE')GOTO950
      IF(IJUST.EQ.'RICE')GOTO960
C
      IF(IJUST.EQ.'LETO')GOTO970
      IF(IJUST.EQ.'CETO')GOTO980
      IF(IJUST.EQ.'RITO')GOTO990
C
      GOTO910
C
  910 CONTINUE
      PXINC=0.0
      PYINC=0.0
      IJUSTH='LEFT'
      IJUSTV='BOTT'
      GOTO995
C
  920 CONTINUE
      PXINC=PXLEC/2.0
      PYINC=0.0
      IJUSTH='CENT'
      IJUSTV='BOTT'
      GOTO995
C
  930 CONTINUE
      PXINC=PXLEC
      PYINC=0.0
      IJUSTH='RIGH'
      IJUSTV='BOTT'
      GOTO995
C
  940 CONTINUE
      PXINC=0.0
      PYINC=PYLEC/2.0
      IJUSTH='LEFT'
      IJUSTV='CENT'
      GOTO995
C
  950 CONTINUE
      PXINC=PXLEC/2.0
      PYINC=PYLEC/2.0
      IJUSTH='CENT'
      IJUSTV='CENT'
      GOTO995
C
  960 CONTINUE
      PXINC=PXLEC
      PYINC=PYLEC/2.0
      IJUSTH='RIGH'
      IJUSTV='CENT'
      GOTO995
C
  970 CONTINUE
      PXINC=0.0
      PYINC=PYLEC
      IJUSTH='LEFT'
      IJUSTV='TOP '
      GOTO995
C
  980 CONTINUE
      PXINC=PXLEC/2.0
      PYINC=PYLEC
      IJUSTH='CENT'
      IJUSTV='TOP '
      GOTO995
C
  990 CONTINUE
      PXINC=PXLEC
      PYINC=PYLEC
      IJUSTH='RIGH'
      IJUSTV='TOP '
      GOTO995
C
  995 CONTINUE
      PXINC2=PXINC*(100.0/(PWXMAX-PWXMIN))
      PYINC2=PYINC*(100.0/(PWYMAX-PWYMIN))
      PX1P=PX1-PXINC2
      PY1P=PY1-PYINC2
C
C               *************************
C               **  STEP XX--          **
C               **  COMPUTE END POINT  **
C               *************************
C
      ANCTEX=NCTEXT
      PX99=PX1P+ANCTEX*(PWIDT2+PHOGA2)
      PY99=PY1P
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  BRANCH ACCORDING TO THE MANUFACTURER            **
C               **  AND THE MODEL                                   **
C               ******************************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      IF(IMODEL.EQ.'35CL')GOTO9600
      IF(IMODEL.EQ.'35BW')GOTO9600
      IF(IMODEL.EQ.'35WB')GOTO9600
      IF(IMODEL.EQ.'PPRN')GOTO9600
      IF(IMODEL.EQ.'PTRA')GOTO9600
      IF(IMODEL.EQ.'KTRA')GOTO9600
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
C               ******************************************************
C
 1100 CONTINUE
      IFACTO=4
CCCCC IF(NUMHPP.GE.4000)IFACTO=1
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (PORTRAIT, SQUARE ORIENTATION)
      IF(NUMVPP.GE.3000)IFACTO=1
      ICSTR(1:1)=IGSC
      NCSTR=1
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IUSC
      DO1110I=1,NCTEXT
      NCSTR=NCSTR+1
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
 1110 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION                  *
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  AND THE TILDA SINGLE (RT-LEFT) QUOTE (= INVOKE LABEL MODE) I
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 80-85, 253-254.                 **
C               **             PAGE 111 AND 112.                    **
C               ******************************************************
C
 2100 CONTINUE
      ICSTR(1:1)='p'
      NCSTR=1
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,2111)(ICTEXT(I),I=1,NCTEP2)
C2111 FORMAT('~''',120A1)
      ICSTR(1:2)='~'''
      NCSTR=2
      DO2112J=1,NCTEXT
      K=J+NCSTR
      ICTEMP=ICTEXT(J)
      ICSTR(K:K)=ICTEMP(1:1)
 2112 CONTINUE
      NCSTR=K
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IETXC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  USE THE PU (= PEN UP) INSTRUCTION               **
C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  AND THE LB (= LABEL) INSTRUCTION                **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 62, 143.                        **
C               **             PAGE 65-67, 143.                     **
C               **             PAGE 75, 141.                        **
C               ******************************************************
C
 2200 CONTINUE
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2211)IX,IY
C2211 FORMAT('PU;PA',I5,',',I5,';')
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      NCTEP1=NCTEXT+1
      NCTEP2=NCTEXT+2
      ICTEXT(NCTEP1)=IETXC
      ICTEXT(NCTEP2)=';'
CCCCC WRITE(IGUNIT,2212)(ICTEXT(J),J=1,NCTEP2)
C2212 FORMAT('LB',120A1)
      ICSTR(1:2)='LB'
      NCSTR=2
      DO2212J=1,NCTEP2
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 2212 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2290 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-12, 10-13, 10-21.
C               **********************************************************
C
C  JULY, 1990.  PACK OUTPUT ONTO 1 LINE.
C
 2300 CONTINUE
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:4)='*pa'
      NCSTR=4
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(10:10)=','
      NCSTR=10
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(16:16)='Z'
      NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      NCTEP1=NCTEXT+1
CCCCC NCTEP2=NCTEXT+2
      ICTEXT(NCTEP1)=ICRC
CCCCC ICTEXT(NCTEP2)='Z'
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='*l'
CCCCC NCSTR=3
      ICSTR(17:17)=IESCC
      ICSTR(18:19)='*l'
      NCSTR=19
CCCCC DO2312J=1,NCTEP2
      DO2312J=1,NCTEP1
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 2312 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2390 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 26--                                           **
C               **  TREAT THE HEWLETT-PACKARD PCL     CASES             **
C               **  (LASERJET SERIES II LASER PRINTERS               )  **
C               **  REFERENCE--LASERJET SERIES II TECHNICAL             **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE                                     **
C               **  FIRST SET FONT IF NECCESSARY                        **
C               **  NOTE THAT ONLY THE STROKE WEIGHT AND THE TYPEFACE   **
C               **  HAVE TO BE SET HERE.  THE POINT SIZE AND CHARACTERS **
C               **  PER INCH ARE SET IN "GRTRSI".  THE OTHER            **
C               **  CHARACTERISTICS DO NOT VARY BETWEEN THE INTERNAL    **
C               **  FONTS AND ARE SET IN "GRINDE".                      **
C               **********************************************************
C
 2600 CONTINUE
      IF(IPCLFN.NE.IPCLFC)GOTO2605
      IPCLFC=IPCLFN
      ICSTR(1:1)=IESCC
C
      ICSTR(2:5)='(s3T'
      IF(IPCLFN.EQ.'COND')ICSTR(4:4)='0'
      ICSTR(6:6)=IESCC
      ICSTR(7:10)='(s0B'
      IF(IPCLFN.EQ.'CBOL')ICSTR(9:9)='3'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2605 CONTINUE
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*p'
      NCSTR=3
      NCHTOT=4
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)='X'
      NCSTR=8
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(13:13)='Y'
      NCSTR=13
C
      DO2612J=1,NCTEXT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEXT(J)
 2612 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
C  JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
C  LET THE POST PROCESOR DO IT
CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NCTEXT.LE.0)GOTO3190
      ICSTR(1:11)='WRITE TEXT '
      NCSTR=11
      K=0
      DO3112J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3112 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3190 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
C  JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
C  LET THE POST PROCESOR DO IT
C  DECEMBER 1997.  SLIGHTLY DIFFERENT CODING FOR GUI.
CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
C
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3260
C
 3250 CONTINUE
      CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
      IPXTMP=INT(AX*10.**IGENFA+0.5)
      IPYTMP=INT(AY*10.**IGENFA+0.5)
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3260 CONTINUE
      IF(NCTEXT.LE.0)GOTO3290
      ICSTR(1:5)='WRTE '
      NCSTR=5
      K=0
      DO3212J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3212 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3290 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 33--                                                **
C               **  TREAT THE CGM                                CASE        **
C               ***************************************************************
C
 3300 CONTINUE
C  JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
C  LET THE POST PROCESOR DO IT
      IF(NCTEXT.LE.0)GOTO3390
C
CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
      PX1P=PX1
      PY1P=PY1
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      ICSTR(1:6)='TEXT ('
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:34)=') FINAL'
      NCSTR=34
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)='"'
      NCSTR=1
      K=0
      DO3312J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3312 CONTINUE
      K=K+1
      ICSTR(K:K)='"'
      K=K+1
      ICSTR(K:K)=';'
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3390 CONTINUE
C
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  USE CALCOMP LIBRARY ROUTINE SYMBOL              **
C               **  REFERENCE--FUNDAMENTAL PLOTTING ROUTINES        **
C               **             FORTRAN REFERENCE MANUAL - NICOLET   **
C               **             PAGES 2-7 (1984 EDITION)             **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT CALCOMP DEV.')
CCCCC ICSTR(1:52)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT CALCOMP DEV.'
CCCCC NCSTR=52
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
      DO4112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4112 CONTINUE
      ANGLE=0.
      AXTEMP=0.
      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      CALL CALCTR(ICSTR,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCTEXT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      ICSTR=' '
      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
      DO4612J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4612 CONTINUE
      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
      ICOLMN=INT(REAL(ILAHEY(8))*(AX1*RLAHEY(1)/11.0)+0.5)
      IF(IJUSTH.EQ.'RIGH')THEN
        NSHIFT=NCTEXT
      ELSEIF(IJUSTH.EQ.'CENT')THEN
        NSHIFT=NCTEXT/2
      ELSE
        NSHIFT=0
      ENDIF
      ICOLMN=ICOLMN-NSHIFT
      IF(ICOLMN.LT.1)ICOLMN=1
      IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
      ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY1)/8.5)+0.5)
      IF(IJUSTV.EQ.'TOP')THEN
        NSHIFT=1
      ELSEIF(IJUSTV.EQ.'CENT')THEN
        NSHIFT=1
      ELSE
        NSHIFT=0
      ENDIF
      ILINE=ILINE-NSHIFT
      IF(ILINE.LT.1)ILINE=1
      IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
CCCCC CALL GTEXT(ILINE,ICOLMN,ICSTR(1:NCTEXT))
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      ICSTR=' '
      DO4712J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4712 CONTINUE
CCCCC CALL GRTRSD(PX1,100.-PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
      IF(IJUSTH.EQ.'LEFT')THEN
        IXINC=0
      ELSEIF(IJUSTH.EQ.'CENT')THEN
CQWVF   IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT))/2
      ELSEIF(IJUSTH.EQ.'RIGH')THEN
CQWVF   IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT))
      ELSE
        IXINC=0
      ENDIF
      IF(IJUSTV.EQ.'TOP ')THEN
        IYINC=0
      ELSEIF(IJUSTV.EQ.'CENT')THEN
        IYINC=JHEIG2/2
      ELSEIF(IJUSTV.EQ.'BOTT')THEN
        IYINC=JHEIG2
      ELSE
        IYINC=0
      ENDIF
CQWVF CALL MOVETO(INT2(IX1-IXINC),INT2(IY1-IYINC),XY)
CQWVF CALL OUTGTEXT(ICSTR(1:NCTEXT))
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IOPGOF.EQ.'OFF')GOTO4899
C
      DO4805I=1,NCTEXT
        IC1=ICTEXT(I)(1:1)
        CALL DPCOAN(IC1,IJUNK)
        STRING(I)=IJUNK
 4805 CONTINUE
      STRING(NCTEXT+1)=0
C
      ILAST=80
      DO4810I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO4819
 4810 CONTINUE
 4819 CONTINUE
      DO4820I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 4820 CONTINUE
      IADE(ILAST+1)=0
C
      CALL GLTATT(IADE,IXERR)
      IF(IXERR.EQ.1) THEN
        WRITE(ICOUT,4821)
 4821 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
      CALL DPWRST('XXX','BUG ')
      ELSEIF(IXERR.EQ.2)THEN
        WRITE(ICOUT,4822)
 4822 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
      CALL DPWRST('XXX','BUG ')
      END IF
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      IXERR=0
      IX1=INT(PX1+0.5)
      IY1=INT(PY1+0.5)
      CALL GLTEXH(STRING,IX1,IY1,IFONTH,IFONTV,IXERR)
C
 4899 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      ICSTR=' '
      DO4952J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4952 CONTINUE
      IF(IJUSTH.EQ.'LEFT')THEN
CWINT   CALL IGrCharJustify('L')
      ELSEIF(IJUSTH.EQ.'CENT')THEN
CWINT   CALL IGrCharJustify('C')
      ELSEIF(IJUSTH.EQ.'RIGH')THEN
CWINT   CALL IGrCharJustify('R')
      ELSE
CWINT   CALL IGrCharJustify('C')
      ENDIF
      PYINC=0.0
      IF(IJUSTV.EQ.'TOP')THEN
CWINT   PYINC=InfoGraphics(4)
      ELSEIF(IJUSTV.EQ.'CENT')THEN
CWINT   PYINC=InfoGraphics(4)/2.0
      ELSEIF(IJUSTV.EQ.'BOTT')THEN
CWINT   PYINC=0.0
      ELSE
CWINT   PYINC=InfoGraphics(4)/2.0
      ENDIF
CWINT CALL IGrCharOut(PX1,PY1+PYINC,ICSTR(1:NCTEXT))
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  USE THE 1 OP CODE (= MOVE)                      **
C               **  ALONG WITH COORDINATES,                         **
C               **  USE THE 3 OP CODE (= CHARACTER STRING)          **
C               **  ALONG WITH RELATIVE COOR                        **
C               **  ALONG WITH NUMBER OF CHAR (= 1)                 **
C               **  ALONG WITH CONVERTED CHAR STRING                **
C               **  (2 CONVERTED CHAR FOR EVERY SINGLE CHAR).       **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 , B-1, AND E-1             **
C               **  REFERENCE--ZETA FORTRAN REFERENCE MANUAL        **
C               **             PAGE A-2                             **
C               **  USE CALCOMP LIBRARY (MARCH,1988)                **
C               ******************************************************
C
 5100 CONTINUE
CCCCC ICSTR(1:1)='1'
CCCCC NCSTR=1
CCCCC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC ICSTR(1:1)='3'
CCCCC NCSTR=1
CCCCC PXDEL=PX99-PX1P
CCCCC PYDEL=PY99-PY1P
CCCCC CALL GRTRSD(PXDEL,PYDEL,IXW,IYH,ISUBN0)
CCCCC CALL ZETRPT(IXW,IYH,ICSTR,NCSTR,ISUBN0)
C
CCCCC NCSTR=NCSTR+1
CCCCC ITENS=NCTEXT/10
CCCCC ITENSP=ITENS+48
CCCCC ICSTR(NCSTR:NCSTR)=CHAR(ITENSP)
CCCCC CALL DPCONA(ITENSP,ICSTR(NCSTR:NCSTR))
C
CCCCC NCSTR=NCSTR+1
CCCCC IUNITS=NCTEXT-10*ITENS
CCCCC IUNITP=IUNITS+48
CCCCC ICSTR(NCSTR:NCSTR)=CHAR(IUNITP)
CCCCC CALL DPCONA(IUNITP,ICSTR(NCSTR:NCSTR))
C
CCCCC IF(NCTEXT.LE.0)GOTO5190
CCCCC DO5110I=1,NCTEXT
CCCCC IC4=ICTEXT(I)
CCCCC IC=IC4(1:4)
CCCCC CALL ZETRCH(IC,IC1,IC2)
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC1
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC2
C5110 CONTINUE
C
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C5190 CONTINUE
      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
      DO5112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 5112 CONTINUE
      ANGLE=0.
      AXTEMP=0.
      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      CALL CALCTR(ICSTR,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCTEXT)
      GOTO9000
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT RAMTEK DEV.')
      ICSTR(1:51)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT RAMTEK DEV.'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
 6600 CONTINUE
      NCSTR=0
C
      DO6610I=1,NCTEXT
      NCSTR=NCSTR+1
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
 6610 CONTINUE
C
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      NCSTR=NCSTR+1
      ITEMP=0
      CALL DPCONA(ITEMP,ICSTR(NCSTR:NCSTR))
CSUN  CALL cftext(IX1P,IY1P,ICSTR(1:NCSTR))
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT XXXXXX DEV.')
      ICSTR(1:51)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT XXXXXX DEV.'
      NCSTR=51
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  USE THE P[ (= POSITION ) INSTRUCTION            **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  WITH A TRAILING ]                               **
C               **  AND THE T' (= TEXT) INSTRUCTION                 **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ' TO DENOTE THE END OF TEXT STRING,         **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 118 AND 120                    **
C               ******************************************************
C
C
C  MARCH, 1991.  PACK OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW THE
C  CURSUR POSITION RATHER THAN ABOVE IT (AS DATAPLOT ASSUMES), SO HAVE
C  TO ADJUST VERTICAL POSITION ONE CHARACTER HEIGHT.
C
 8100 CONTINUE
      PY1P=PY1P+PHEIG2
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      ICSTR(1:2)='P['
      NCSTR=2
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)=','
      NCSTR=8
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(14:14)=']'
      NCSTR=14
      IF(NCTEP1.GT.110)THEN
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=0
      END IF
C
      NCTEP1=NCTEXT+1
      ICTEXT(NCTEP1)=''''
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='T'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=''''
      DO8112J=1,NCTEP1
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 8112 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 8190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT CASE                       **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  XCOOR YCOOR MOVETO   (NOTE: USE UNADJUSTED COOR)**
C               **  (STRING) SHOW                                   **
C               **  NOTE:  RIGHTSHOW AND CENTSHOW ARE DATAPLOT      **
C               **         DEFINED PROCEDURES TO RIGHT AND CENTER   **
C               **         JUSTIFY STRINGS RESPECTIVELY             **
C               **  REFERENCE--POSTSCRIPT TUTORIAL AND COOKBOOK     **
C               **             FROM ADOBE SYSTEMS                   **
C               **  FIRST SET FONT IF REQUIRED                      **
C               **  CHECK FOR FOLLOWING CHARACTERS AND IF FOUND     **
C               **  PRECEDE WITH A BACKSLASH                        **
C               **  "(", ")", AND BACKSLASH                         **
C               ******************************************************
C
C
 8600 CONTINUE
      IPSTPS=INT(JHEIG2+0.5)
      IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605
C  FOLLOWING CODE MODIFIED OCTOBER 1991.
      IJUNK=7
      DO8695I=1,IPSTMF
      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
      IJUNK=I
      GOTO8697
 8695 CONTINUE
 8697 CONTINUE
      ICSTR(1:1)='/'
      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
      ICSTR(42:51)=' findfont '
      NCHTOT=5
      NCSTR=51
      CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+17
      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:33)='/Times-Roman            findfont '
CCCCC IF(IPSTFN.EQ.'TBOL')
CCCCC1ICSTR(1:23)='/Times-Bold            '
CCCCC IF(IPSTFN.EQ.'TITA')
CCCCC1ICSTR(1:23)='/Times-Italic          '
CCCCC IF(IPSTFN.EQ.'TBIT')
CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
CCCCC IF(IPSTFN.EQ.'HELV')
CCCCC1ICSTR(1:23)='/Helvetica             '
CCCCC IF(IPSTFN.EQ.'HELB')
CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
CCCCC IF(IPSTFN.EQ.'HELO')
CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
CCCCC IF(IPSTFN.EQ.'HEBO')
CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
CCCCC IF(IPSTFN.EQ.'COUR')
CCCCC1ICSTR(1:23)='/Courier               '
CCCCC IF(IPSTFN.EQ.'CBOL')
CCCCC1ICSTR(1:23)='/Courier-Bold          '
CCCCC IF(IPSTFN.EQ.'COBL')
CCCCC1ICSTR(1:23)='/Courier-Oblique       '
CCCCC IF(IPSTFN.EQ.'CBOB')
CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
CCCCC NCSTR=33
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(39:56)=' scalefont setfont'
CCCCC NCSTR=56
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  END OF CHANGE
      IPSTFC=IPSTFN
      IPSTPC=IPSTPS
C
 8605 CONTINUE
CCCCC 6 LINES IN THE FOLLOWING SECTION WERE FIXED   MAY 1991  (ALAN)
CCCCC ICSTR(1:3)='/IX '
      ICSTR(1:4)='/IX '
CCCCC NCSTR=3
      NCSTR=4
      CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(9:17)=' def /IY '
      ICSTR(10:18)=' def /IY '
CCCCC NCSTR=17
      NCSTR=18
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(23:26)=' def'
      ICSTR(24:27)=' def'
CCCCC NCSTR=26
      NCSTR=27
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)='('
      NCSTR=1
      DO8612J=1,NCTEXT
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.ICTEXT(J).NE.IBASLC)
     * GOTO8613
      NCSTR=NCSTR+1
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      ICSTR(NCSTR:NCSTR)=IBASLC
 8613 CONTINUE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEXT(J)
 8612 CONTINUE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(IJUST(1:1).EQ.'L')ICSTR(1:9)='leftshow '
      IF(IJUST(1:1).EQ.'C')ICSTR(1:9)='centshow '
      IF(IJUST(1:1).EQ.'R')ICSTR(1:9)='rightshow'
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC       CASE                       **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  MOVE: ^IHXXXXX^IVXXXXX                          **
C               **  SET DEFAULT FONT:^ISXXXXX                       **
C               **  SET FONT FOR CURRENT LINE: ^SMXXXXX             **
C               **  ENTER TEXT                                      **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL FOR QMS      **
C               **             CHAPTER 7 DISCUSSES FONTS            **
C               ******************************************************
C
C
 9100 CONTINUE
      IFONTT=IQUIFN
      IF(IORNSW.EQ.'PORT'.AND.(
     1IFONTT.EQ.521.OR.
     1IFONTT.EQ.522.OR.
     1IFONTT.EQ.523.OR.
     1IFONTT.EQ.524))IFONTT=10
      IF(IORNSW.NE.'PORT'.AND.(
     1IFONTT.EQ.124.OR.
     1IFONTT.EQ.144.OR.
     1IFONTT.EQ.16.OR.
     1IFONTT.EQ.328.OR.
     1IFONTT.EQ.998.OR.
     1IFONTT.EQ.404.OR.
     1IFONTT.EQ.444.OR.
     1IFONTT.EQ.532))IFONTT=10
      CALL DPCONA(94,ICARAT)
      IF(IFONTT.EQ.IQUIFC)GOTO9105
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IS'
      IQUIFC=IFONTT
      KFONT=IFONTT
      NCHTOT=-5
      NCSTR=3
      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9105 CONTINUE
      PYTEMP=100.-PY1P
      CALL QUICPT(PX1P,PYTEMP,IX,IY,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IH'
      NCSTR=3
      NCHTOT=-5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(9:9)=ICARAT
      ICSTR(10:11)='IV'
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=16
C
      DO9112J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 9112 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  NOTE THAT JUSTIFICATION, POSITIONING, ETC. IS   **
C               **  HANDLED BY THE C ROUTINE.  ALSO, THE CHARACTER  **
C               **  STRING IS PASSED TO C AS AN INTEGER ARRAY       **
C               **  CONTAINING THE ASCII DECIMAL EQUIVALENTS        **
C               ******************************************************
C
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9699
C
      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
C
      DO9605I=1,NCTEXT
        IC1=ICTEXT(I)(1:1)
        CALL DPCOAN(IC1,IJUNK)
        STRING(I)=IJUNK
 9605 CONTINUE
      STRING(NCTEXT+1)=0
C
      ILAST=80
      DO9610I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO9619
 9610 CONTINUE
 9619 CONTINUE
      DO9620I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 9620 CONTINUE
      IADE(ILAST+1)=0
C
      CALL XTATTR(IADE,IXERR)
      IF(IXERR.EQ.1) THEN
        WRITE(ICOUT,9621)
 9621 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
      CALL DPWRST('XXX','BUG ')
      ELSEIF(IXERR.EQ.2)THEN
        WRITE(ICOUT,9622)
 9622 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
      CALL DPWRST('XXX','BUG ')
      END IF
C
      IFONTH=0
      IFONTV=0
      IF(IJUST.EQ.'LEFT')IFONTH=0
      IF(IJUST.EQ.'CENT')IFONTH=1
      IF(IJUST.EQ.'RIGH')IFONTH=2
      IF(IJUST.EQ.'LJUS')IFONTH=0
      IF(IJUST.EQ.'CJUS')IFONTH=1
      IF(IJUST.EQ.'RJUS')IFONTH=2
      IF(IJUST.EQ.'LEBO')IFONTH=0
      IF(IJUST.EQ.'CEBO')IFONTH=1
      IF(IJUST.EQ.'RIBO')IFONTH=2
      IF(IJUST.EQ.'LECE')IFONTH=0
      IF(IJUST.EQ.'CECE')IFONTH=1
      IF(IJUST.EQ.'RICE')IFONTH=2
      IF(IJUST.EQ.'LETO')IFONTH=0
      IF(IJUST.EQ.'CETO')IFONTH=1
      IF(IJUST.EQ.'RITO')IFONTH=2
      IF(IJUST.EQ.'LEFT')IFONTV=1
      IF(IJUST.EQ.'CENT')IFONTV=1
      IF(IJUST.EQ.'RIGH')IFONTV=1
      IF(IJUST.EQ.'LJUS')IFONTV=1
      IF(IJUST.EQ.'CJUS')IFONTV=1
      IF(IJUST.EQ.'RJUS')IFONTV=1
      IF(IJUST.EQ.'LEBO')IFONTV=1
      IF(IJUST.EQ.'CEBO')IFONTV=1
      IF(IJUST.EQ.'RIBO')IFONTV=1
      IF(IJUST.EQ.'LECE')IFONTV=0
      IF(IJUST.EQ.'CECE')IFONTV=0
      IF(IJUST.EQ.'RICE')IFONTV=0
      IF(IJUST.EQ.'LETO')IFONTV=2
      IF(IJUST.EQ.'CETO')IFONTV=2
      IF(IJUST.EQ.'RITO')IFONTV=2
      IXERR=0
      CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR)
C
 9699 CONTINUE
C
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
CCCCC AND REFIXED                       SEPTEMBER 1995
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 124, 113.    **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 324-325, 256.              **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 59-60, 54-55**
C               *************************************************
C
10000 CONTINUE
      IF(ITCST.EQ.'CLOS')GOTO10099
C
CCCCC THE FOLLOWING 2 LINES OF CODE WERE REPLACED  SEPTEMBER 1994
CCCCC BY THE SUBSEQUENT 7 LINES OF CODE            SEPTEMBER 1994
CCCCC TO FIX C-SIDE MULTIPLOTTING NOT WORKING      SEPTEMBER 1994
C
CCCCC CALL TCMOTO(PX1,PY1)
CCCCC CALL TCWRTE(ICTEXT,NCTEXT)
C
      IF(NCTEXT.LE.0)GOTO10099
c
CCCCC SEE COMMENTS FOR GENERAL CODED (STEP 32) FOR NEXT 2 LINES
C
CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
      PX1P=PX1
      PY1P=PY1
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL TCMOTO(PX1P,PY1P)
      CALL TCWRTE(ICTEXT,NCTEXT)
C
10099 CONTINUE
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  TREAT THE PBM (PORTABLE BIT MAP) DRIVER         **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      IF(JJUST.EQ.1)THEN
        IAQJUS=8+0
      ELSEIF(JJUST.EQ.2)THEN
        IAQJUS=8+1
      ELSEIF(JJUST.EQ.3)THEN
        IAQJUS=8+2
      ELSEIF(JJUST.EQ.4)THEN
        IAQJUS=0 + 0
      ELSEIF(JJUST.EQ.5)THEN
        IAQJUS=0+1
      ELSEIF(JJUST.EQ.6)THEN
        IAQJUS=0+2
      ELSEIF(JJUST.EQ.7)THEN
        IAQJUS=16 + 0
      ELSEIF(JJUST.EQ.8)THEN
        IAQJUS=16 + 1
      ELSEIF(JJUST.EQ.9)THEN
        IAQJUS=16 + 2
      ELSE
        IAQJUS=8
      ENDIF
      AROT=0.0
CAQUA aqtAddLabel(ICTEXT(1:NCTEXT),PX1,PY1,AROT,IAQJUS)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
      CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0)
      ICSTR(1:1)=IBASLC
      ICSTR(2:5)='put('
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
      ICSTR(NCSTR+2:NCSTR+2)=IBASLC
      NCSTR=NCSTR+15
C
      IF(IJUSTV.EQ.'CENT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='c'
      ELSEIF(IJUSTV.EQ.'BOTT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='b'
      ELSEIF(IJUSTV.EQ.'TOP ')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='t'
      ENDIF
C
      IF(IJUSTH.EQ.'CENT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='c'
      ELSEIF(IJUSTH.EQ.'LEFT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='l'
      ELSEIF(IJUSTH.EQ.'RIGH')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='r'
      ENDIF
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=']'
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      DO15110J=1,NCTEXT
        ICSTR2(J:J)=ICTEXT(J)(1:1)
15110 CONTINUE
      MAXWID=130
      CALL LATCON(ICSTR2,NCTEXT,ICSTR3,NCTEX2,MAXWID,ISUBRO,IERROR)
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='{'
      ICNT=NCSTR
      DO15120J=1,NCTEX2
        ICNT=ICNT+1
        ICSTR(ICNT:ICNT)=ICSTR3(J:J)
15120 CONTINUE
      NCSTR=ICNT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+1)='}}'
      NCSTR=NCSTR+1
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0)
C
      CALL DPCONA(34,IQUOTE)
C
      ICSTR(1:11)='   <text x='
      NCSTR=12
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+2)=' y='
      NCSTR=NCSTR+3
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(ISVGSS(1:3).EQ.'EXT')THEN
        NCSTR=12
        ICSTR(1:NCSTR)='      class='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
C
        IF(IJUSTH.EQ.'CENT')THEN
          ICSTR(NCSTR:NCSTR+16)='center-horizontal'
          NCSTR=NCSTR+17
        ELSEIF(IJUSTH.EQ.'LEFT')THEN
          ICSTR(NCSTR:NCSTR+14)='left-horizontal'
          NCSTR=NCSTR+15
        ELSEIF(IJUSTH.EQ.'RIGH')THEN
          ICSTR(NCSTR:NCSTR+15)='right-horizontal'
          NCSTR=NCSTR+16
        ENDIF
C
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        CALL GRTRCO('FORE',ISVGFC,JCOL2)
        IFLAG=0
        IF(JCOL2.NE.JCOL)THEN
          IFLAG=1
          ICSTR(1:12)='      style='
          ICSTR(13:13)=IQUOTE
          NCSTR=-13
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:21)='             stroke:#'
          NCSTR=21
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+2
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
        IF(JHEIG2.NE.9)THEN
          IF(IFLAG.EQ.0)THEN
            ICSTR(1:12)='      style='
            ICSTR(13:13)=IQUOTE
            NCSTR=-13
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
            IFLAG=1
          ENDIF
          NCSTR=22
          ICSTR(1:NCSTR)='            font-size:'
          NCHTOT=3
          CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
       ENDIF
       IF(IFLAG.EQ.1)THEN
          NCSTR=13
          ICSTR(1:NCSTR)='             '
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='>'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
       ENDIF
C
      ELSE
        NCSTR=14
        ICSTR(1:NCSTR)='        style='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        IF(IJUSTH.EQ.'CENT')THEN
          NCSTR=29
          ICSTR(1:NCSTR)='         text-anchor:Middle;'
        ELSEIF(IJUSTH.EQ.'RIGH')THEN
          NCSTR=25
          ICSTR(1:NCSTR)='         text-anchor:End;'
        ELSE
          NCSTR=28
          ICSTR(1:NCSTR)='         text-anchor:Start;'
        ENDIF
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCSTR=21
        ICSTR(1:NCSTR)='         font-family:'
        DO16010I=32,1,-1
          NCTEMP=I
          IF(ISVGFN(I:I).NE.' ')GOTO16011
16010   CONTINUE
16011   CONTINUE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
        NCSTR=NCSTR+NCTEMP
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        IF(ISVGFW.EQ.'NORM')THEN
          NCSTR=28
          ICSTR(1:NCSTR)='         font-weight:normal;'
          NCSTR=-NCSTR
        ELSE
          NCSTR=26
          ICSTR(1:NCSTR)='         font-weight:bold;'
          NCSTR=-NCSTR
        ENDIF
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        IF(ISVGST.EQ.'ITAL')THEN
          NCSTR=27
          ICSTR(1:NCSTR)='         font-style:italic;'
          NCSTR=-NCSTR
        ELSE
          NCSTR=27
          ICSTR(1:NCSTR)='         font-style:normal;'
          NCSTR=-NCSTR
        ENDIF
        NCSTR=19
        ICSTR(1:NCSTR)='         font-size:'
        NCHTOT=3
        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCSTR=17
        ICSTR(1:NCSTR)='         stroke:#'
        NCHTOT=2
        JTEMP=JCOL
        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCSTR=9
        ICSTR(1:NCSTR)='         '
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='>'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ENDIF
C
      DO16112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
16112 CONTINUE
      NCSTR=-NCTEXT
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:10)='   </text>'
      NCSTR=-10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRWRTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PX1,PY1
 9013 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCTEXT
 9014 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(ICTEXT(I),I=1,NCTEXT)
 9015 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)JSIZE
 9016 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,JDIR
 9023 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILL,JFILL
 9025 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)PTHICK,JTHICK,PTHIC2
 9031 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)PXDEL,PYDEL
 9035 FORMAT('PXDEL,PYDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IC4,IC,IC1,IC2
 9036 FORMAT('IC4,IC,IC1,IC2 = ',A4,2X,A1,2X,A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)PXINC,PYINC
 9037 FORMAT('PXINC,PYINC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)PXINC2,PYINC2
 9038 FORMAT('PXINC2,PYINC2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)NCSTR
 9043 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9047
      DO9045I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
 9046 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9045 CONTINUE
 9047 CONTINUE
      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRWRTV(PX1,PY1,ICTEXT,NCTEXT,
     1IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1PX99,PY99)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              AND FOR THE STANDARD (HARDWARE-GENERATED) FONT,
C              GO TO THE POINT (PX1,PY1) AND WRITE OUT
C              THE TEXT STRING
C              (IN A VERTICAL (DOWN) DIRECTION)
C              CONTAINED IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF NCTEXT CHARACTERS.
C     NOTE--THE STRING WILL BE WRITTEN DOWN
C            BUT EACH CHARACTER WILL BE HORIZONTAL.
C            THIS IS A REFLECTION OF THE FACT
C            THAT TEKTRONIX HARDWARE-GENERATED
C            SYMBOLS SOULD NOT (ON 4014, ETC.) BE ROTATED.
C            THE CODE IN THIS SUBROUTINE COULD BE
C            UPDATED TO TAKE ADVANTAGE OF THE FACT
C            THAT SOME DEVICES (E.G., HP AND ZETA)
C            CAN ROTATE CHARACTERS.
C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
C           THAT IS, EACH IS 0.0 TO 100.0.
C     NOTE--THE SUBSECTION    RWIND    HAS BEEN EXTRACTED
C           OUT OF     PLOT CONTROL COMMON   .
C           THIS (AND GRWRTH) ARE THE ONLY SUBROUTINES WHERE
C           THIS SUB-EXTRACTION HAS BEEN DONE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
C                                      DRIVER OBSOLETE
C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
C     UPDATED         --OCTOBER  1989.  RWIND CORRECTION (NELSON HSU)
C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
C     UPDATED         --JULY     1990.  PACK HP2622 OUTPUT
C     UPDATED         --MARCH    1991.  PACK REGIS OUTPUT
C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
C                                      DRIVER OBSOLETE
C     UPDATED         --MAY      1991. FIX POSTSCRIPT CHAR. INDICES
C     UPDATED         --OCTOBER  1991.  POSTSCRIPT FONTS (ALAN)
C     UPDATED         --JUNE     1994. MAJOR MODIFICATIONS: (ALAN)
C                                      1) FIX JUSTIFICATION LOGIC
C                                      2) POSTSCRIPT AND X11 DO JUST IN
C                                         DEVICE DRIVER, SOME SPECIAL
C                                         HANDLING REQUIRED.
C                                      3) DISTINGUISH ROTATABLE AND
C                                         NON-ROTATABLE CHARACTERS
C                                      4) SCALE FACTOR (FOR MULTIPLOT
C                                         CASE) FOR UNROTATED DEVICES
C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
C                                       BAD C-SIDE MULTIPLOTTING (SCALING)
C     UPDATED         --JANUARY   1995. FIX FRONT END Y1LABEL
C     UPDATED         --SEPTEMBER 1995. RETROACTIVE JIM/ALAN MERGE
C     UPDATED         --SEPTEMBER 1995. FIX TURBO-C SECTION
C                            BAD C-SIDE MULTIPLOTTING (SCALING) (AGAIN)
C     UPDATED         --SEPTEMBER 1995. REFIX TURBO-C SECTION
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C                                      OLD, CALCOMP STYLE
C                                      DRIVER OBSOLETE
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C                                      USE BILL MITCHELLS OPENGL
C                                      BINDING FOR FORTRAN
C     UPDATED         --OCTOBER  1996. GKS (ALAN)
C                                      CODED, NOT TESTED
C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
C     UPDATED         --JUNE     2000. MACINTOSH
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --JUNE     2000. PC PRINTER
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
C                                      PLACEHOLDER FOR NOW
C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
CWINT USE WINTERACTER
CINTE USE INTERACTER
CQWIN USE DFLIB
CIVFO USE IFQWIN
CQWVF TYPE (XYCOORD) XY
CQWVF TYPE (FONTINFO) MSFONT
CQWVF TYPE (WINDOWCONFIG)   DPSCREEN
CQWVF CHARACTER*4 QWSCRN
CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
C
      CHARACTER*4 ICTEXT
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
C
      CHARACTER*4 IC4
      CHARACTER*1 IC
      CHARACTER*1 IC1
      CHARACTER*1 IC2
C
      CHARACTER*130 ICSTR
      CHARACTER*130 ICSTR2
      CHARACTER*130 ICSTR3
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ICTEMP
C
      CHARACTER*1 ICARAT
      CHARACTER*1 IQUOTE
      CHARACTER*2 ICJUNK
      DIMENSION ICTEXT(*)
      DIMENSION IHOLL(33)
C  FOLLOWING 2 LINES MARCH, 1990 FOR X11 DEVICE
      INTEGER STRING(130)
      INTEGER IADE(80)
CCCCC FOLLOWING 5 LINES FOR LAHEY COMPILER ADDED JULY 1996.
      CHARACTER*4 IJUSTH
      CHARACTER*4 IJUSTV
      CHARACTER*40 CLAHEY
      REAL RLAHEY(7)
      INTEGER ILAHEY(9)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODV.INC'
C     THE FOLLOWING CORRECTION WAS MADE NOVEMBER 1989
CCCCC COMMON /RWIND/
CCCCC1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
CCCCC1WWXMIN,WWXMAX,WWYMIN,WWYMAX
      COMMON /RWIND/
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PYZMAX,
     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      PARAMETER(MAXCLR=89)
      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      EXTERNAL XTEXTV, XTATTR
C
CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
      INCLUDE 'DPCOCT.INC'
C
C-----START POINT-----------------------------------------------------
C
      ISUBN0='WRTV'
      ISUBRO=ISUBG4
C
      NCSTR=(-999)
C
      IC4='-999'
      IC='-'
      IC1='-'
      IC2='-'
C
      PXDEL=(-999.0)
      PYDEL=(-999.0)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTV')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRWRTV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PX1,PY1
   53 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PX99,PY99
   54 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NCTEXT
   55 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)(ICTEXT(I),I=1,NCTEXT)
   56 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)JSIZE
   57 FORMAT('JSIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT,JPATT
   59 FORMAT('IPATT,JPATT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST,JJUST
   62 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR,JDIR
   63 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILL,JFILL
   65 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL,JCOL
   66 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
   71 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************************
C               **  STEP XX--                                       **
C               **  COMPUTE NEW START POINTS DEPENDING              **
C               **  ON THE JUSTIFICATION                            **
C               **  NOTE THAT TEKTRONIX CHARACTERS CANNOT BE ROTATED**
C               **  AND SO THE SETTINGS ARE SOMEWHAT STRANGE        **
C               **  (HEIGHT FOR WIDTH AND WIDTH FOR HEIGHT)         **
C               ******************************************************
CCCCC JUNE 1994.  FIX JUSTIFICATION IN FOLLOWING 2 WAYS:
CCCCC             1) DISTINGUISH BETWEEN THOSE DEVICES THAT ROTATE
CCCCC                CHARACTERS AND THOSE THAT DO NOT.
CCCCC             2) RETHINK LOGIC SO THAT HORIZONTAL IS STILL
CCCCC                LEFT TO RIGHT AND VERTICAL IS STILL TOP TO 
CCCCC                BOTTOM.
C
      IF(IMANUF.EQ.'POST')GOTO801
      IF(IMANUF.EQ.'CALC')GOTO801
      IF(IMANUF.EQ.'ZETA')GOTO801
      IF(IMANUF.EQ.'SVG ')GOTO801
      IF(IMANUF.EQ.'LATE')GOTO998
      GOTO901
C
C      ***************************************
C      **  ROTATED DEVICES                  **
C      ***************************************
C
  801 CONTINUE
      IF(IJUST.EQ.'LEFT')GOTO820
      IF(IJUST.EQ.'CENT')GOTO850
      IF(IJUST.EQ.'RIGH')GOTO880
C
      IF(IJUST.EQ.'LJUS')GOTO820
      IF(IJUST.EQ.'CJUS')GOTO850
      IF(IJUST.EQ.'RJUS')GOTO880
C
      IF(IJUST.EQ.'LEBO')GOTO810
      IF(IJUST.EQ.'CEBO')GOTO820
      IF(IJUST.EQ.'RIBO')GOTO830
C
      IF(IJUST.EQ.'LECE')GOTO840
      IF(IJUST.EQ.'CECE')GOTO850
      IF(IJUST.EQ.'RICE')GOTO860
C
      IF(IJUST.EQ.'LETO')GOTO870
      IF(IJUST.EQ.'CETO')GOTO880
      IF(IJUST.EQ.'RITO')GOTO890
C
      GOTO810
C
  810 CONTINUE
      PXINC=-PHEIG2
      PYINC=0.0
      GOTO995
C
  820 CONTINUE
      PXINC=-PHEIG2/2.0
      PYINC=0.0
      GOTO995
C
  830 CONTINUE
      PXINC=0.0
      PYINC=0.0
      GOTO995
C
  840 CONTINUE
      PXINC=-PHEIG2
      PYINC=PXLECG/2.0
      GOTO995
C
  850 CONTINUE
      PXINC=-PHEIG2/2.0
      PYINC=PXLECG/2.0
      GOTO995
C
  860 CONTINUE
      PXINC=0.0
      PYINC=PXLECG/2.0
      GOTO995
C
  870 CONTINUE
      PXINC=-PHEIG2
      PYINC=PXLECG
      GOTO995
C
  880 CONTINUE
      PXINC=-PHEIG2/2.0
      PYINC=PXLECG
      GOTO995
C
  890 CONTINUE
      PXINC=0.0
      PYINC=PXLECG
      GOTO995
C
C
C      ***************************************
C      **  UNROTATED DEVICES                **
C      ***************************************
CCCCC JUNE 1994.  FOLLOWING SECTION REWRITTEN.
C
  901 CONTINUE
CCCCC JULY, 1996.  ADD SETTINGS FOR IJUSTH, IJUSTV IN FOLLOWING BLOCK
      IJUSTH='LEFT'
      IJUSTV='BOTT'
C
CCCCC IF(IJUST.EQ.'LEFT')GOTO910
CCCCC IF(IJUST.EQ.'CENT')GOTO920
CCCCC IF(IJUST.EQ.'RIGH')GOTO930
      IF(IJUST.EQ.'LEFT')GOTO920
      IF(IJUST.EQ.'CENT')GOTO950
      IF(IJUST.EQ.'RIGH')GOTO980
C
CCCCC IF(IJUST.EQ.'LJUS')GOTO910
CCCCC IF(IJUST.EQ.'CJUS')GOTO920
CCCCC IF(IJUST.EQ.'RJUS')GOTO930
      IF(IJUST.EQ.'LJUS')GOTO920
      IF(IJUST.EQ.'CJUS')GOTO950
      IF(IJUST.EQ.'RJUS')GOTO980
C
      IF(IJUST.EQ.'LEBO')GOTO910
      IF(IJUST.EQ.'CEBO')GOTO920
      IF(IJUST.EQ.'RIBO')GOTO930
C
      IF(IJUST.EQ.'LECE')GOTO940
      IF(IJUST.EQ.'CECE')GOTO950
      IF(IJUST.EQ.'RICE')GOTO960
C
      IF(IJUST.EQ.'LETO')GOTO970
      IF(IJUST.EQ.'CETO')GOTO980
      IF(IJUST.EQ.'RITO')GOTO990
C
      GOTO910
C
  910 CONTINUE
      PXINC=0.0
      PYINC=-PYLEC+PHEIG2
      IJUSTH='LEFT'
      IJUSTV='TOP '
      GOTO995
C
  920 CONTINUE
CCCCC PXINC=0.0
CCCCC PYINC=-(PYLEC/2.0)+PHEIG2
      PXINC=PWIDT2/2.0
      PYINC=-PYLEC+PHEIG2
      IJUSTH='CENT'
      IJUSTV='TOP '
      GOTO995
C
  930 CONTINUE
CCCCC PXINC=0.0
CCCCC PYINC=PHEIG2
      PXINC=PWIDT2
      PYINC=-PYLEC+PHEIG2
      IJUSTH='RIGH'
      IJUSTV='TOP '
      GOTO995
C
  940 CONTINUE
CCCCC PXINC=PWIDT2/2.0
CCCCC PYINC=-PYLEC+PHEIG2
      PXINC=0.0
      PYINC=-(PYLEC/2.0)+PHEIG2
      IJUSTH='LEFT'
      IJUSTV='CENT'
      GOTO995
C
  950 CONTINUE
CCCCC PXINC=PWIDT2/2.0
      PXINC=PWIDT2/2.0
      PYINC=-(PYLEC/2.0)+PHEIG2
      IJUSTH='CENT'
      IJUSTV='CENT'
      GOTO995
C
  960 CONTINUE
CCCCC PXINC=PWIDT2/2.0
CCCCC PYINC=PHEIG2
      PXINC=PWIDT2
      PYINC=-(PYLEC/2.0)+PHEIG2
      IJUSTH='RIGH'
      IJUSTV='CENT'
      GOTO995
C
  970 CONTINUE
CCCCC PXINC=PWIDT2
CCCCC PYINC=-PYLEC+PHEIG2
      PXINC=0.0
      PYINC=PHEIG2
      IJUSTH='LEFT'
      IJUSTV='BOTT'
      GOTO995
C
  980 CONTINUE
CCCCC PXINC=PWIDT2
CCCCC PYINC=-(PYLEC/2.0)+PHEIG2
      PXINC=PWIDT2/2.0
      PYINC=PHEIG2
      IJUSTH='CENT'
      IJUSTV='BOTT'
      GOTO995
C
  990 CONTINUE
      PXINC=PWIDT2
      PYINC=PHEIG2
      IJUSTH='RIGH'
      IJUSTV='BOTT'
      GOTO995
C
  995 CONTINUE
CCCCC PX1P=PX1-PXINC
CCCCC PY1P=PY1-PYINC
CCCCC JUNE 1994.  DEFINE SCALE FACTOR
      AFACT=100.0/(PWXMAX-PWXMIN)
CCCCC PXINC2=PXINC*(100.0/(PWXMAX-PWXMIN))
CCCCC PYINC2=PYINC*(100.0/(PWYMAX-PWYMIN))
      PXINC2=PXINC*AFACT
      PYINC2=PYINC*AFACT
      PX1P=PX1-PXINC2
      PY1P=PY1-PYINC2
CCCCC JUNE 1994.  FOR POSTSCRIPT, Y JUSTIFICATION DONE IN DRIVER.
CCCCC             X COORDINATE CONTAINS BOTH CHARACTER AND GAP, USE A
CCCCC             FUDGE FACTOR TO COMPENSATE (PROBABLY NOT TOTALLY
CCCCC             ACCURATE, BUT BETTER THAN NO ADJUSTMENT).
      IF(IMANUF.EQ.'POST')THEN
        PY1P=PY1
        PX1P=PX1-0.75*PXINC2
      ENDIF
C
C
C               *************************
C               **  STEP XX--          **
C               **  COMPUTE END POINT  **
C               *************************
C
      ANCTEX=NCTEXT
      PX99=PX1P
      PY99=PY1P-ANCTEX*AFACT*(PHEIG2+PVEGA2)
C
  998 CONTINUE

C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'TEKT')GOTO1005
      IF(IMANUF.EQ.'HP')GOTO1010
      IF(IMANUF.EQ.'PCL')GOTO1015
      IF(IMANUF.EQ.'GENE')GOTO1020
      IF(IMANUF.EQ.'CALC')GOTO1025
      IF(IMANUF.EQ.'ZETA')GOTO1030
      IF(IMANUF.EQ.'RAMT')GOTO1035
      IF(IMANUF.EQ.'SUN ')GOTO1040
      IF(IMANUF.EQ.'XXXX')GOTO1045
      IF(IMANUF.EQ.'REGI')GOTO1050
      IF(IMANUF.EQ.'POST')GOTO1055
      IF(IMANUF.EQ.'QUIC')GOTO1060
      IF(IMANUF.EQ.'X11 ')GOTO1065
      IF(IMANUF.EQ.'TURB')GOTO1070
      IF(IMANUF.EQ.'GKS ')GOTO1075
      IF(IMANUF.EQ.'LAHE')GOTO1080
      IF(IMANUF.EQ.'GD  ')GOTO1085
      IF(IMANUF.EQ.'QWIN')GOTO1090
      IF(IMANUF.EQ.'AQUA')GOTO1091
      IF(IMANUF.EQ.'OPGL')GOTO1095
      IF(IMANUF.EQ.'PRIN')GOTO1096
      IF(IMANUF.EQ.'LATE')GOTO1097
      IF(IMANUF.EQ.'MACI')GOTO1098
      IF(IMANUF.EQ.'SVG ')GOTO1099
      GOTO9000
C
 1005 CONTINUE
      GOTO1100
C
 1010 CONTINUE
      IF(IMODEL.EQ.'7221')GOTO2100
      IF(IMODEL.EQ.'2622')GOTO2300
      IF(IMODEL.EQ.'2623')GOTO2300
      IF(IMODEL.EQ.'2627')GOTO2300
      IF(IMODEL.EQ.'2647')GOTO2300
      GOTO2200
C
 1015 CONTINUE
      GOTO2600
C
 1020 CONTINUE
      IF(IMODEL.EQ.'CODE')GOTO3200
      IF(IMODEL.EQ.'CGM')GOTO3300
      IF(IMODEL.EQ.'CGMB')GOTO3400
      GOTO3100
C
 1025 CONTINUE
      GOTO4100
C
 1030 CONTINUE
      GOTO5100
C
 1035 CONTINUE
      GOTO6100
C
 1040 CONTINUE
      GOTO6600
C
 1045 CONTINUE
      GOTO7100
C
 1050 CONTINUE
      GOTO8100
C
 1055 CONTINUE
      IF(IMODEL.EQ.'DISP')GOTO8900
      GOTO8600
C
 1060 CONTINUE
      GOTO9100
C
 1065 CONTINUE
      GOTO9600
C
 1070 CONTINUE
      GOTO10000
C
 1075 CONTINUE
      GOTO11000
C
 1080 CONTINUE
      IF(IMODEL.EQ.'INTE')GOTO4900
      IF(IMODEL.EQ.'WINT')GOTO4950
      GOTO4600
C
 1085 CONTINUE
      IF(IMODEL.EQ.'JPEG')GOTO12000
      IF(IMODEL.EQ.'PNG ')GOTO12000
      IF(IMODEL.EQ.'WBMP')GOTO12000
      IF(IMODEL.EQ.'GIF')GOTO12000
      GOTO12000
C
 1090 CONTINUE
      GOTO4700
C
 1091 CONTINUE
      GOTO13500
C
 1095 CONTINUE
      GOTO4800
C
 1096 CONTINUE
      GOTO14000
C
 1097 CONTINUE
      GOTO15000
C
 1098 CONTINUE
      GOTO13000
C
 1099 CONTINUE
      GOTO16000
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
C               ******************************************************
C
 1100 CONTINUE
CCCCC IFACTO=4
CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (PORTRAIT, SQUARE ORIENTATION)
      IF(NUMHPP.GE.4000)IFACTO=1
      IF(NCTEXT.LE.0)GOTO1190
      DO1110I=1,NCTEXT
      ICSTR(1:1)=IGSC
      NCSTR=1
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IUSC
      NCSTR=NCSTR+1
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 1110 CONTINUE
 1190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
C               **  (MULTI-COLOR PENPLOTTER)                        **
C               **  TO WRITE A "VERTICAL" TEXT STRING--             **
C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION                  *
C               **  AND PACKED BINARY COORDINATES,                  **
C               **  AND THE TILDA SINGLE (RT-LEFT) QUOTE (= INVOKE LABEL MODE) I
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 80-85, 253-254.                 **
C               **             PAGE 111 AND 112.                    **
C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
C               **        ADVANTAGE OF THE FACT THAT                **
C               **        THAT HP CAN ROTATE ITS CHARACTERS.        **
C               ******************************************************
C
 2100 CONTINUE
C
      IF(NCTEXT.LE.0)GOTO2190
      DO2110I=1,NCTEXT
C
      ICSTR(1:1)='p'
      NCSTR=1
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='}'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,2111)ICTEXT(I),IETXC
C2111 FORMAT('~''',A1,A1,'}')
      ICSTR(1:2)='~'''
      ICTEMP=ICTEXT(I)
      ICSTR(3:3)=ICTEMP(1:1)
      ICSTR(4:4)=IETXC
      NCSTR=4
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2110 CONTINUE
 2190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
C               **  (MULTI-COLOR PENPLOTTERS)                       **
C               **  TO WRITE A VERTICAL TEXT STRING--               **
C               **  USE THE PU (= PEN UP) INSTRUCTION               **
C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  AND THE LB (= LABEL) INSTRUCTION                **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
C               **             OPERATING AND PROGRAMMING MANUAL,    **
C               **             PAGE 62, 143.                        **
C               **             PAGE 65-67, 143.                     **
C               **             PAGE 75, 141.                        **
C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
C               **        ADVANTAGE OF THE FACT THAT                **
C               **        THAT HP CAN ROTATE ITS CHARACTERS.        **
C               ******************************************************
C
 2200 CONTINUE
C
      IF(NCTEXT.LE.0)GOTO2290
      DO2210I=1,NCTEXT
C
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC WRITE(IGUNIT,2211)IX,IY
C2211 FORMAT('PU;PA',I5,',',I5,';')
      ICSTR(1:5)='PU;PA'
      NCSTR=5
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(11:11)=','
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      ICSTR(17:17)=';'
      NCSTR=17
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC WRITE(IGUNIT,2212)ICTEXT(I),IETXC
C2212 FORMAT('LB',A1,A1,';')
      ICSTR(1:2)='LB'
      NCSTR=2
      ICTEMP=ICTEXT(I)
      ICSTR(3:3)=ICTEMP(1:1)
      ICSTR(4:4)=IETXC
      ICSTR(5:5)=';'
      NCSTR=5
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2210 CONTINUE
 2290 CONTINUE
      GOTO9000
C
C               **********************************************************
C               **  STEP 23--                                           **
C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
C               **  (MONOCHROME DISPLAY TERMINALS)                      **
C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
C               **             REFERENCE MANUAL,                        **
C               **             PAGE 10-12, 10-13, 10-21.
C               **********************************************************
C
C  JULY, 1990.  PACK OUTPUT (REQUESTED BY MIKE KELLY FOR BETTER PEROFRMANCE
C  ON THE HP EMULATOR PACKAGE).  NOTE THAT THE TEXT STRING TERMINATES WITH
C  A  , SO ONLY PUT 1 LINE AT A TIME.  HOWEVER, THIS STILL REDUCES NUMBER
C  OF LINES BY HALF.
C
 2300 CONTINUE
C
      IF(NCTEXT.LE.0)GOTO2390
      NCSTR=0
      DO2310I=1,NCTEXT
C
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
CCCCC IF(I.GE.2)PY1P=PY1P-2.0*(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*2.0*(PHEIG2+PVEGA2)
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      IF(NCSTR.LE.84)GOTO2315
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=0
 2315 CONTINUE
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:4)='*pa'
CCCCC NCSTR=4
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(10:10)=','
CCCCC NCSTR=10
CCCCC CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(16:16)='Z'
CCCCC NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IESCC
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+2
      ICSTR(NCSTR:NCSTR2)='*pa'
      NCSTR=NCSTR2
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='Z'
C
CCCCC ICSTR(1:1)=IESCC
CCCCC ICSTR(2:3)='*l'
CCCCC NCSTR=3
CCCCC ICTEMP=ICTEXT(I)
CCCCC ICSTR(4:4)=ICTEMP(1:1)
CCCCC ICSTR(5:5)=ICRC
CCCCC ICSTR(6:6)='Z'
CCCCC NCSTR=6
CCCCC NCSTR=5
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IESCC
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)='*l'
      NCSTR=NCSTR2+1
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICRC
C
 2310 CONTINUE
      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2390 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 26--                                       **
C               **  TREAT THE PCL                   CASE            **
C               ******************************************************
C
 2600 CONTINUE
      IF(NCTEXT.LE.0)GOTO2690
C
      IF(IPCLFN.NE.IPCLFC)GOTO2605
      IPCLFC=IPCLFN
      ICSTR(1:1)=IESCC
C
      ICSTR(2:5)='(s3T'
      IF(IPCLFN.EQ.'COND')ICSTR(4:4)='0'
      ICSTR(6:6)=IESCC
      ICSTR(7:10)='(s0B'
      IF(IPCLFN.EQ.'CBOL')ICSTR(9:9)='3'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 2605 CONTINUE
      DO2610I=1,NCTEXT
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
      ICSTR(1:1)=IESCC
      ICSTR(2:3)='*p'
      NCHTOT=4
      NCSTR=3
      CALL GRTRIN(IX1P,NCHTOT,ICSTR,NCSTR)
      ICSTR(8:8)='X'
      NCSTR=8
      CALL GRTRIN(IY1P,NCHTOT,ICSTR,NCSTR)
      ICSTR(13:13)='Y'
      ICTEMP=ICTEXT(I)
      NCSTR=14
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 2610 CONTINUE
 2690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 31--                                       **
C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
C               ******************************************************
C
 3100 CONTINUE
      IF(NCTEXT.LE.0)GOTO3190
C  JANUARY 1988: SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
C  OR LET THE POST PROCESSOR DO IT
CCCCC THE FOLLOWING LINE WAS CHANGED     JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')GOTO3150
      GOTO3150
C
CCCCC DO3110I=1,NCTEXT
CCCCC IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
C3111 FORMAT('MOVE TO ',F10.5,2X,F10.5)
CCCCC ICSTR(1:8)='MOVE TO '
CCCCC NCSTR=8
CCCCC NCHTOT=10
CCCCC NCHDEC=5
CCCCC CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
CCCCC PX1P=AX
CCCCC PY1P=AY
CCCCC CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC ICSTR(19:20)='  '
CCCCC NCSTR=20
CCCCC CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C3112 FORMAT('WRITE TEXT ',A1)
CCCCC ICSTR(1:11)='WRITE TEXT '
CCCCC ICTEMP=ICTEXT(I)
CCCCC ICSTR(12:12)=ICTEMP(1:1)
CCCCC NCSTR=12
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C3110 CONTINUE
CCCCC GOTO3190
C
 3150 CONTINUE
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:11)='WRITE TEXT '
      NCSTR=11
      DO3160I=1,NCTEXT
      ICTEMP=ICTEXT(I)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
 3160 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3190 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
C  DECEMBER 1997.  MODIFY GENERAL CODED FOR THE GUI.
C
 3200 CONTINUE
      IF(NCTEXT.LE.0)GOTO3290
C  JANUARY 1988: SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
C  OR LET THE POST PROCESSOR DO IT
CCCCC THE FOLLOWING LINE WAS CHANGED     JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')GOTO3250
      GOTO3250
CCCCC DO3210I=1,NCTEXT
CCCCC IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
CCCCC ICSTR(1:5)='MOTO '
CCCCC NCSTR=5
CCCCC NCHTOT=10
CCCCC NCHDEC=5
CCCCC CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
CCCCC PX1P=AX
CCCCC PY1P=AY
CCCCC CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC ICSTR(16:17)='  '
CCCCC NCSTR=17
CCCCC CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:5)='WRTE '
CCCCC ICTEMP=ICTEXT(I)
CCCCC ICSTR(6:6)=ICTEMP(1:1)
CCCCC NCSTR=6
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C3210 CONTINUE
CCCCC GOTO3290
C
 3250 CONTINUE
      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3280
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3260I=1,NCTEXT
      ICTEMP=ICTEXT(I)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
 3260 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO3290
C
 3280 CONTINUE
      CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
      IPXTMP=INT(AX*10.**IGENFA+0.5)
      IPYTMP=INT(AY*10.**IGENFA+0.5)
      ICSTR(1:2)='M '
      NCSTR=2
      NCHTOT=IGENFA+3
      CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='  '
      CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:5)='WRTE '
      NCSTR=5
      DO3285I=1,NCTEXT
      ICTEMP=ICTEXT(I)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
 3285 CONTINUE
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3290 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 33--                                       **
C               **  TREAT THE GENERAL (CGM               ) CASE     **
C               ******************************************************
C
 3300 CONTINUE
      IF(NCTEXT.LE.0)GOTO3390
C  SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
C  OR LET THE POST PROCESSOR DO IT
CCCCC THE FOLLOWING LINE WAS CHANGED     JANUARY 1995
CCCCC IF(IJUSSW.EQ.'ON')GOTO3350
      GOTO3350
C
CCCCC ICSTR(1:16)='TEXTPATH RIGHT;'
CCCCC NCSTR=16
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC DO3330I=1,NCTEXT
CCCCC IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
CCCCC CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
CCCCC PX1P=AX
CCCCC PY1P=AY
CCCCC ICSTR(1:6)='TEXT ('
CCCCC NCSTR=6
CCCCC NCHTOT=10
CCCCC NCHDEC=5
CCCCC CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC ICSTR(17:17)=','
CCCCC NCSTR=17
CCCCC CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
CCCCC ICSTR(28:36)=') FINAL "'
CCCCC ICTEMP=ICTEXT(I)
CCCCC ICSTR(37:37)=ICTEMP(1:1)
CCCCC ICSTR(38:39)='";'
CCCCC NCSTR=39
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C3330 CONTINUE
CCCCC GOTO3390
C
 3350 CONTINUE
C
      ICSTR(1:15)='TEXTPATH DOWN;'
      NCSTR=15
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:6)='TEXT ('
      NCSTR=6
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(17:17)=','
      NCSTR=17
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(28:34)=') FINAL'
      NCSTR=34
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      ICSTR(1:1)='"'
      NCSTR=1
      K=0
      DO3362J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3362 CONTINUE
      K=K+1
      ICSTR(K:K)='"'
      K=K+1
      ICSTR(K:K)=';'
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 3390 CONTINUE
      GOTO9000
C
C               ***************************************************
C               **  STEP 34--                                    **
C               **  TREAT THE CGM (BINARY)                 CASE  **
C               ***************************************************
C
 3400 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  TREAT THE CALCOMP XXXXXX CASE                   **
C               **  TO WRITE A VERTICAL TEXT STRING--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  USE CALCOMP LIBRARY ROUTINES                    **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 4100 CONTINUE
CCCCC WRITE(IGUNIT,4111)
C4111 FORMAT('FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT CALCOMP')
CCCCC ICSTR(1:48)='FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT CALCOMP'
CCCCC NCSTR=48
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
      DO4112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4112 CONTINUE
      ANGLE=90.
      AXTEMP=0.
      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      NCSTR=NCTEXT
      CALL CALCTR(ICSTR,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCSTR)
C
C               ******************************************************
C               **  STEP 46--                                       **
C               **  TREAT THE LAHEY   XXXXXX CASE                   **
C               **  REFERENCE--Programmer's Reference, Revision C   **
C               **             Lahey Computer Systems, January, 1992**
C               **             PAGES 51 THRU 65                     **
C               ******************************************************
C
 4600 CONTINUE
      IF(NCTEXT.LE.0)GOTO4690
      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
      PX1P=PX1
      PY1P=PY1
      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
      ICOLMN=INT(REAL(ILAHEY(8))*(AX1*RLAHEY(1)/11.0)+0.5)
      ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY1)/8.5)+0.5)
      IF(IJUSTH.EQ.'LEFT')THEN
        NSHIFT=0
      ELSEIF(IJUSTH.EQ.'CENT')THEN
        NSHIFT=1
      ELSEIF(IJUSTH.EQ.'RIGH')THEN
        NSHIFT=1
      ELSE
        NSHIFT=0
      ENDIF
      ICOLMN=ICOLMN-NSHIFT
      IF(ICOLMN.LT.1)ICOLMN=1
      IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
      IF(IJUSTV.EQ.'TOP ')THEN
        NSHIFT=0
      ELSEIF(IJUSTV.EQ.'CENT')THEN
        NSHIFT=NCTEXT/2
      ELSEIF(IJUSTV.EQ.'BOTT')THEN
        NSHIFT=NCTEXT
      ELSE
        NSHIFT=0
      ENDIF
      ILINE=ILINE-NSHIFT
      IF(ILINE.LT.1)ILINE=1
      IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
      DO4610I=1,NCTEXT
C
      ICTEMP=' '
      ICTEMP(1:1)=ICTEXT(I)
      IF(ILINE.GE.1.AND.ILINE.LE.ILAHEY(9))
     1     CALL GTEXT(ILINE,ICOLMN,ICTEMP)
      ILINE=ILINE+1
C
 4610 CONTINUE
 4690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 47--                                       **
C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
C               ******************************************************
C
 4700 CONTINUE
      ICSTR=' '
      DO4712J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 4712 CONTINUE
CCCCC CALL GRTRSD(PX1,100.-PY1,IX1,IY1,ISUBN0)
      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
CQWVF CALL SETGTEXTROTATION(900)
CQWVF IWIDTH=GETGTEXTEXTENT(ICSTR(1:NCTEXT))
C
      IF(IJUST.EQ.'LEFT')GOTO4720
      IF(IJUST.EQ.'CENT')GOTO4750
      IF(IJUST.EQ.'RIGH')GOTO4780
C
      IF(IJUST.EQ.'LJUS')GOTO4720
      IF(IJUST.EQ.'CJUS')GOTO4750
      IF(IJUST.EQ.'RJUS')GOTO4780
C
      IF(IJUST.EQ.'LEBO')GOTO4710
      IF(IJUST.EQ.'CEBO')GOTO4720
      IF(IJUST.EQ.'RIBO')GOTO4730
C
      IF(IJUST.EQ.'LECE')GOTO4740
      IF(IJUST.EQ.'CECE')GOTO4750
      IF(IJUST.EQ.'RICE')GOTO4760
C
      IF(IJUST.EQ.'LETO')GOTO4770
      IF(IJUST.EQ.'CETO')GOTO4780
      IF(IJUST.EQ.'RITO')GOTO4790
C
      GOTO4710
C
 4710 CONTINUE
      IXINC=-IWIDTH
      IYINC=0
      GOTO4795
C
 4720 CONTINUE
      IXINC=-IWIDTH/2
      IYINC=0
      GOTO4795
C
 4730 CONTINUE
      IXINC=0
      IYINC=0
      GOTO4795
C
 4740 CONTINUE
      IXINC=-IWIDTH
      IYINC=JHEIG2/2
      GOTO4795
C
 4750 CONTINUE
      IXINC=-IWIDTH/2
      IYINC=JHEIG2/2
      GOTO4795
C
 4760 CONTINUE
      IXINC=0
      IYINC=JHEIG2/2
      GOTO4795
C
 4770 CONTINUE
      IXINC=-IWIDTH
      IYINC=JHEIG2
      GOTO4795
C
 4780 CONTINUE
      IXINC=-IWIDTH/2
      IYINC=JHEIG2
      GOTO4795
C
 4790 CONTINUE
      IXINC=0
      IYINC=JHEIG2
 4795 CONTINUE
C
CQWVF CALL MOVETO(INT2(IX1+IXINC),INT2(IY1+IYINC),XY)
CQWVF CALL OUTGTEXT(ICSTR(1:NCTEXT))
CQWVF CALL SETGTEXTROTATION(0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 48--                                       **
C               **  TREAT THE OPEN-GL DRIVER                        **
C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
C               ******************************************************
C
 4800 CONTINUE
      IF(IOPGOF.EQ.'OFF')GOTO4899
C
      DO4805I=1,NCTEXT
        IC1=ICTEXT(I)(1:1)
        CALL DPCOAN(IC1,IJUNK)
        STRING(I)=IJUNK
 4805 CONTINUE
      STRING(NCTEXT+1)=0
C
      ILAST=80
      DO4810I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO4819
 4810 CONTINUE
 4819 CONTINUE
      DO4820I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 4820 CONTINUE
      IADE(ILAST+1)=0
C
      CALL GLTATT(IADE,IXERR)
      IF(IXERR.EQ.1) THEN
        WRITE(ICOUT,4821)
 4821 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
      CALL DPWRST('XXX','BUG ')
      ELSEIF(IXERR.EQ.2)THEN
        WRITE(ICOUT,4822)
 4822 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
      CALL DPWRST('XXX','BUG ')
      END IF
C
      IFONTH=0
      IFONTV=0
C
      IF(IJUST.EQ.'LEFT'.OR.IJUST.EQ.'LJUS')THEN
        IFONTH=1
        IFONTV=1
      ELSEIF(IJUST.EQ.'CENT'.OR.IJUST.EQ.'CJUS')THEN
        IFONTH=1
        IFONTV=0
      ELSEIF(IJUST.EQ.'RIGH'.OR.IJUST.EQ.'RJUS')THEN
        IFONTH=1
        IFONTV=2
      ELSEIF(IJUST.EQ.'LEBO')THEN
        IFONTH=0
        IFONTV=1
      ELSEIF(IJUST.EQ.'CEBO')THEN
        IFONTH=1
        IFONTV=1
      ELSEIF(IJUST.EQ.'RIBO')THEN
        IFONTH=2
        IFONTV=1
      ELSEIF(IJUST.EQ.'LECE')THEN
        IFONTH=0
        IFONTV=0
      ELSEIF(IJUST.EQ.'CECE')THEN
        IFONTH=1
        IFONTV=0
      ELSEIF(IJUST.EQ.'RICE')THEN
        IFONTH=2
        IFONTV=0
      ELSEIF(IJUST.EQ.'LETO')THEN
        IFONTH=0
        IFONTV=2
      ELSEIF(IJUST.EQ.'CETO')THEN
        IFONTH=1
        IFONTV=2
      ELSEIF(IJUST.EQ.'RITO')THEN
        IFONTH=2
        IFONTV=2
      ENDIF
C
      IXERR=0
      CALL GLTEXV(STRING,PX1,PY1,IFONTH,IFONTV,IXERR)
C
 4899 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49--                                       **
C               **  TREAT THE LAHEY INTERACTOR CASE                 **
C               ******************************************************
C
 4900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 49B-                                       **
C               **  TREAT THE LAHEY WINTERACTOR CASE                **
C               ******************************************************
C
 4950 CONTINUE
      IF(NCTEXT.LE.0)GOTO4990
CWINT CALL IGrCharJustify('C')
      NCSTR=0
      PY1P=PY1P+PHEIG2
      DO4910I=1,NCTEXT
C
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
CWINT CALL IGrCharOut(PX1,PY1+PY1P,ICSTR(I:I))
 4910 CONTINUE
C
 4990 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 51--                                       **
C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
C               **  TO WRITE A VERTICAL TEXT STRING--               **
C               **  USE THE 1 OP CODE (= MOVE)                      **
C               **  ALONG WITH COORDINATES,                         **
C               **  USE THE 3 OP CODE (= CHARACTER STRING)          **
C               **  ALONG WITH RELATIVE COOR                        **
C               **  ALONG WITH NUMBER OF CHAR (= 1)                 **
C               **  ALONG WITH CONVERTED CHAR STRING                **
C               **  (2 CONVERTED CHAR FOR EVERY SINGLE CHAR).       **
C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
C               **             MODELS 3600SX AND 3653SX             **
C               **             PAGES B-0 , B-1, AND E-1             **
C               **  REFERENCE--ZETA FORTRAN REFERENCE MANUAL        **
C               **             PAGE A-2                             **
C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
C               **        ADVANTAGE OF THE FACT THAT                **
C               **        THAT ZETA CAN ROTATE ITS CHARACTERS.      **
C               ******************************************************
C
 5100 CONTINUE
C
CCCCC IF(NCTEXT.LE.0)GOTO5190
CCCCC PXDEL=PWIDT2+PHOGA2
CCCCC PYDEL=PHEIG2+PVEGA2
C
CCCCC DO5110I=1,NCTEXT
C
CCCCC ICSTR(1:1)='1'
CCCCC NCSTR=1
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
CCCCC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
CCCCC ICSTR(1:1)='3'
CCCCC NCSTR=1
C
CCCCC CALL GRTRSD(PXDEL,PYDEL,IXW,IYH,ISUBN0)
CCCCC CALL ZETRPT(IXW,IYH,ICSTR,NCSTR,ISUBN0)
C
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='0'
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)='1'
C
CCCCC IC4=ICTEXT(I)
CCCCC IC=IC4(1:4)
CCCCC CALL ZETRCH(IC,IC1,IC2)
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC1
CCCCC NCSTR=NCSTR+1
CCCCC ICSTR(NCSTR:NCSTR)=IC2
C
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C5110 CONTINUE
C
C5190 CONTINUE
CCCCC GOTO9000
      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
      DO5112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
 5112 CONTINUE
      ANGLE=90.
      AXTEMP=0.
      CALL CALCPT(AYTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
      CALL CALCTR(ICSTR,IHOLL,NCTEXT)
CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCTEXT)
C
C               ******************************************************
C               **  STEP 61--                                       **
C               **  TREAT THE RAMTEK XXXXXX CASE                    **
C               **  TO WRITE A VERTICAL TEXT STRING--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 6100 CONTINUE
CCCCC WRITE(IGUNIT,6111)
C6111 FORMAT('FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT RAMTEK')
      ICSTR(1:47)='FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT RAMTEK'
      NCSTR=47
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 66--                                       **
C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
C               ******************************************************
C
 6600 CONTINUE
      IF(NCTEXT.LE.0)GOTO6690
      DO6610I=1,NCTEXT
      NCSTR=1
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      ICTEMP=ICTEXT(I)
      ICSTR(1:1)=ICTEMP(1:1)
      ITEMP=0
      CALL DPCONA(ITEMP,ICSTR(2:2))
CCCCC ICSTR(2:2)=CHAR(0)
      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
CSUN  CALL cftext(IX1P,IY1P,ICSTR(1:2))
 6610 CONTINUE
 6690 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 71--                                       **
C               **  TREAT THE XXXXXX  XXXXXX CASE                   **
C               **  TO WRITE A VERTICAL TEXT STRING--               **
C               **  WRITE OUT AN XXXXXXXXXX                         **
C               **  (NOT DONE)                                      **
C               **  REFERENCE--XX                                   **
C               **             XX                                   **
C               **             PAGES XX AND XX                      **
C               ******************************************************
C
 7100 CONTINUE
CCCCC WRITE(IGUNIT,7111)
C7111 FORMAT('FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT XXXXXX')
      ICSTR(1:47)='FIX SUBROUTINE GRWRTV TO WRITE VERT TEXT XXXXXX'
      NCSTR=47
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 81--                                       **
C               **  TREAT THE DEC  REGIS CASE                       **
C               **  TO WRITE A HORIZONTAL TEXT STRING--              **
C               **  USE THE P[ (= POSITION ) INSTRUCTION            **
C               **  ALONG WITH INTEGER COORDINATES,                 **
C               **  WITH A TRAILING ]                               **
C               **  AND THE T' (= TEXT) INSTRUCTION                 **
C               **  AND THE DESIRED TEXT STRING,                    **
C               **  AND ' TO DENOTE THE END OF TEXT STRING,         **
C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
C               **             PAGES 118 AND 120                    **
C               ******************************************************
C
C  MARCH, 1991.  PACK REGIS OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW
C  RATHER THAN ABOVE THE CURSUR POSITION (AS DATAPLOT ASSUMES), SO ADJUST
C  STARTING POSITION BY A CHARACTER HEIGHT.
C
 8100 CONTINUE
C
      IF(NCTEXT.LE.0)GOTO8190
      NCSTR=0
      NCHTOT=5
      MAXREG=130
      PY1P=PY1P+PHEIG2
      DO8110I=1,NCTEXT
C
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      IF(NCSTR.GT.MAXREG-18)THEN
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        NCSTR=0
      END IF
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+1
      ICSTR(NCSTR:NCSTR2)='P['
      NCSTR=NCSTR2
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=']'
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='T'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=''''
      NCSTR=NCSTR+1
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=''''
C
 8110 CONTINUE
      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 8190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 86--                                       **
C               **  TREAT THE POSTSCRIPT            CASE            **
C               **  TO WRITE A VERTICAL   TEXT STRING--             **
C               **  90 ROTATE                                       **
C               **  XCOOR YCOOR MOVETO   (NOTE: USE UNADJUSTED COOR)**
C               **  (STRING) SHOW                                   **
C               **  -90 ROTATE                                      **
C               **  NOTE:  RIGHTSHOW AND CENTSHOW ARE DATAPLOT      **
C               **         DEFINED PROCEDURES TO RIGHT AND CENTER   **
C               **         JUSTIFY STRINGS RESPECTIVELY             **
C               **  REFERENCE--POSTSCRIPT TUTORIAL AND COOKBOOK     **
C               **             FROM ADOBE SYSTEMS                   **
C               **  FIRST SET FONT IF REQUIRED                      **
C               **  CHECK FOR "(", ")", AND BACKSLASH AND PRECEDE WITH A  **
C               **  BACKSLASH                                       **
C               ******************************************************
C  OCTOBER 1991.  MAKE POSTSCRIPT FONTS TABLE DRIVEN
C
 8600 CONTINUE
      IPSTPS=INT(JHEIG2+0.5)
      IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605
C  FOLLOWING CODE MODIFIED OCTOBER 1991.
      IJUNK=7
      DO8695I=1,IPSTMF
      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
      IJUNK=I
      GOTO8697
 8695 CONTINUE
 8697 CONTINUE
      ICSTR(1:1)='/'
      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
      ICSTR(42:51)=' findfont '
      NCHTOT=5
      NCSTR=51
      CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      NCSTR2=NCSTR+17
      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
      NCSTR=NCSTR2
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
CCCCC ICSTR(1:33)='/Times-Roman            findfont '
CCCCC IF(IPSTFN.EQ.'TBOL')
CCCCC1ICSTR(1:23)='/Times-Bold            '
CCCCC IF(IPSTFN.EQ.'TITA')
CCCCC1ICSTR(1:23)='/Times-Italic          '
CCCCC IF(IPSTFN.EQ.'TBIT')
CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
CCCCC IF(IPSTFN.EQ.'HELV')
CCCCC1ICSTR(1:23)='/Helvetica             '
CCCCC IF(IPSTFN.EQ.'HELB')
CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
CCCCC IF(IPSTFN.EQ.'HELO')
CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
CCCCC IF(IPSTFN.EQ.'HEBO')
CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
CCCCC IF(IPSTFN.EQ.'COUR')
CCCCC1ICSTR(1:23)='/Courier               '
CCCCC IF(IPSTFN.EQ.'CBOL')
CCCCC1ICSTR(1:23)='/Courier-Bold          '
CCCCC IF(IPSTFN.EQ.'COBL')
CCCCC1ICSTR(1:23)='/Courier-Oblique       '
CCCCC IF(IPSTFN.EQ.'CBOB')
CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
CCCCC NCSTR=33
CCCCC NCHTOT=5
CCCCC CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(39:56)=' scalefont setfont'
CCCCC NCSTR=56
CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
C  END OF CHANGE
      IPSTFC=IPSTFN
      IPSTPC=IPSTPS
C
 8605 CONTINUE
CCCCC 6 LINES IN THIS SECTION WERE FIXED   MAY 1991  (ALAN)
CCCCC ICSTR(1:3)='/IX '
      ICSTR(1:4)='/IX '
CCCCC NCSTR=3
      NCSTR=4
      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(9:17)=' def /IY '
      ICSTR(10:18)=' def /IY '
CCCCC NCSTR=17
      NCSTR=18
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
CCCCC ICSTR(23:53)=' def newpath IX IY moveto gsave'
      ICSTR(24:54)=' def newpath IX IY moveto gsave'
CCCCC NCSTR=53
      NCSTR=54
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:1)='('
      NCSTR=1
      DO8612J=1,NCTEXT
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.ICTEXT(J).NE.IBASLC)
     * GOTO8613
      NCSTR=NCSTR+1
CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
      ICSTR(NCSTR:NCSTR)=IBASLC
8613  CONTINUE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=ICTEXT(J)
 8612 CONTINUE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(IJUST(3:4).EQ.'BO')ICSTR(1:10)='vleftshow '
      IF(IJUST(3:4).EQ.'CE')ICSTR(1:10)='vcentshow '
      IF(IJUST(3:4).EQ.'TO')ICSTR(1:10)='vrightshow'
      IF(IJUST.EQ.'LEFT')ICSTR(1:10)='vleftshow '
      IF(IJUST.EQ.'LJUS')ICSTR(1:10)='vleftshow '
      IF(IJUST.EQ.'CENT')ICSTR(1:10)='vcentshow '
      IF(IJUST.EQ.'CJUS')ICSTR(1:10)='vcentshow '
      IF(IJUST.EQ.'RIGH')ICSTR(1:10)='vrightshow'
      IF(IJUST.EQ.'RJUS')ICSTR(1:10)='vrightshow'
      NCSTR=10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 8690 CONTINUE
      ICSTR(1:8)='grestore'
      NCSTR=8
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C
C               ******************************************************
C               **  STEP 89--                                       **
C               **  TREAT THE DISPLAY POSTSCRIPT DRIVER             **
C               ******************************************************
C
 8900 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 91--                                       **
C               **  TREAT THE QUIC                  CASE            **
C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
C               **  MOVE: ^IHXXXXX^IVXXXXX                          **
C               **  SET DEFAULT FONT:^ISXXXXX                       **
C               **  SET FONT FOR CURRENT LINE: ^SMXXXXX             **
C               **  ENTER TEXT                                      **
C               **  REFERENCE--QUIC PROGRAMMING MANUAL FOR QMS      **
C               **             CHAPTER 7 DISCUSSES FONTS            **
C               ******************************************************
C
 9100 CONTINUE
C
      IF(NCTEXT.LE.0)GOTO9190
      IFONTT=IQUIFN
      IF(IORNSW.EQ.'PORT'.AND.(
     1IFONTT.EQ.521.OR.
     1IFONTT.EQ.522.OR.
     1IFONTT.EQ.523.OR.
     1IFONTT.EQ.524))IFONTT=10
      IF(IORNSW.NE.'PORT'.AND.(
     1IFONTT.EQ.124.OR.
     1IFONTT.EQ.144.OR.
     1IFONTT.EQ.16.OR.
     1IFONTT.EQ.328.OR.
     1IFONTT.EQ.998.OR.
     1IFONTT.EQ.404.OR.
     1IFONTT.EQ.444.OR.
     1IFONTT.EQ.532))IFONTT=10
      CALL DPCONA(94,ICARAT)
      IF(IFONTT.EQ.IQUIFC)GOTO9105
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IS'
      IQUIFC=IFONTT
      KFONT=IFONTT
      NCHTOT=-5
      NCSTR=3
      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
      NCSTR=9
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
 9105 CONTINUE
      NCHTOT=-5
      DO9110I=1,NCTEXT
CCCCC IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
      IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
      PYTEMP=100.-PY1P
      CALL QUICPT(PX1P,PYTEMP,IX,IY,ISUBN0)
      ICSTR(1:1)=ICARAT
      ICSTR(2:3)='IH'
      NCSTR=3
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      ICSTR(9:9)=ICARAT
      ICSTR(10:11)='IV'
      NCSTR=11
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=17
C
      ICTEMP=ICTEXT(I)
      ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 9110 CONTINUE
C
 9190 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 96--                                       **
C               **  TREAT THE X11        CASE                       **
C               **  NOTE THAT JUSTIFICATION, POSITIONING, ETC. IS   **
C               **  HANDLED BY THE C ROUTINE.  ALSO, THE CHARACTER  **
C               **  STRING IS PASSED TO C AS AN INTEGER ARRAY       **
C               **  CONTAINING THE ASCII DECIMAL EQUIVALENTS        **
C               ******************************************************
C
 9600 CONTINUE
      IF(IX11OF.EQ.'OFF')GOTO9699
C
      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
C
      DO9605I=1,NCTEXT
        IC1=ICTEXT(I)(1:1)
        CALL DPCOAN(IC1,IJUNK)
        STRING(I)=IJUNK
 9605 CONTINUE
      STRING(NCTEXT+1)=0
C
      ILAST=80
      DO9610I=80,1,-1
        ILAST=I
        IF(IX11FN(I:I).NE.' ')GOTO9619
 9610 CONTINUE
 9619 CONTINUE
      DO9620I=1,ILAST
        CALL DPCOAN(IX11FN(I:I),IJUNK)
        IADE(I)=IJUNK
 9620 CONTINUE
      IADE(ILAST+1)=0
C
      CALL XTATTR(IADE,IXERR)
      IF(IXERR.EQ.1) THEN
        WRITE(ICOUT,9621)
 9621 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
      CALL DPWRST('XXX','BUG ')
      ELSEIF(IXERR.EQ.2)THEN
        WRITE(ICOUT,9622)
 9622 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
      CALL DPWRST('XXX','BUG ')
      END IF
C
      IFONTH=0
      IFONTV=0
C
      IF(IJUST.EQ.'LEFT'.OR.IJUST.EQ.'LJUS')THEN
        IFONTH=1
        IFONTV=1
      ELSEIF(IJUST.EQ.'CENT'.OR.IJUST.EQ.'CJUS')THEN
        IFONTH=1
        IFONTV=0
      ELSEIF(IJUST.EQ.'RIGH'.OR.IJUST.EQ.'RJUS')THEN
        IFONTH=1
        IFONTV=2
      ELSEIF(IJUST.EQ.'LEBO')THEN
        IFONTH=0
        IFONTV=1
      ELSEIF(IJUST.EQ.'CEBO')THEN
        IFONTH=1
        IFONTV=1
      ELSEIF(IJUST.EQ.'RIBO')THEN
        IFONTH=2
        IFONTV=1
      ELSEIF(IJUST.EQ.'LECE')THEN
        IFONTH=0
        IFONTV=0
      ELSEIF(IJUST.EQ.'CECE')THEN
        IFONTH=1
        IFONTV=0
      ELSEIF(IJUST.EQ.'RICE')THEN
        IFONTH=2
        IFONTV=0
      ELSEIF(IJUST.EQ.'LETO')THEN
        IFONTH=0
        IFONTV=2
      ELSEIF(IJUST.EQ.'CETO')THEN
        IFONTH=1
        IFONTV=2
      ELSEIF(IJUST.EQ.'RITO')THEN
        IFONTH=2
        IFONTV=2
      ENDIF
C
      IXERR=0
      CALL XTEXTV(STRING,IX,IY,IFONTH,IFONTV,IXERR)
C
 9699 CONTINUE
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
CCCCC AND REFIXED                       SEPTEMBER 1995
C               *************************************************
C               **  STEP 100--                                 **
C               **  TREAT THE VGA VIA TURBO-C       CASE       **
C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
C               **             ENHANCEMENTS, PAGE 124, 113.    **
C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
C               **             PAGE 324-325, 256.              **
C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
C               **             USING TURBO C, PAGE 59-60, 54-55**
C               *************************************************
C
10000 CONTINUE
      IF(ITCST.EQ.'CLOS')GOTO10099
C
CCCCC THE FOLLOWING 2 LINES OF CODE WERE REPLACED  SEPTEMBER 1994
CCCCC BY THE REST OF THIS SECTION                  SEPTEMBER 1994
CCCCC TO FIX C-SIDE MULTIPLOTTING NOT WORKING      SEPTEMBER 1994
C
CCCCC CALL TCMOTO(PX1,PY1)
CCCCC CALL TCWRTE(ICTEXT,NCTEXT)
C
      IF(NCTEXT.LE.0)GOTO10099
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AND    JANUARY 1995
CCCCC THE FOLLOWING SECTION WAS COMMENTED OUT     JANUARY 1995
CCCCC TO FIX THE Y1LABEL PROBLEM                  JANUARY 1995
CCCCC IF(IJUSSW.NE.'ON')THEN
CCCCC IF(1.EQ.1)THEN
CCCCC    DO10010I=1,NCTEXT
CCCCC       IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
CCCCC       CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
CCCCC       PX1P=AX
CCCCC       PY1P=AY
CCCCC       CALL TCMOTO(PX1P,PY1P)
CCCCC       CALL TCWRTE(ICTEXT(I),6)
C10010    CONTINUE
CCCCC ENDIF
C
CCCCC THE FOLLOWING SECTION WAS CHANGED     JANUARY 1995
CCCCC TO FIX THE Y1LABEL PROBLEM            JANUARY 1995
      PX1P=PX1
      PY1P=PY1
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL TCMOTO(PX1P,PY1P)
      CALL TCWRTE(ICTEXT,NCTEXT)
C
CCCCC NCSTR=0
CCCCC DO10020I=1,NCTEXT
CCCCC    NCSTR=NCSTR+1
CCCCC    ICTEMP=ICTEXT(I)
CCCCC    ICSTR(I:I)=ICTEMP(1:1)
C10020 CONTINUE
CCCCC CALL TCWRTE(ICSTR,NCSTR)
10099 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 110--                                      **
C               **  TREAT THE GKS                DRIVER             **
C               ******************************************************
C
11000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 120--                                      **
C               **  TREAT THE GD                     DRIVER         **
C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
C               **  1) JPEG                                         **
C               **  2) PNG                                          **
C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
C               **  TREAT THE PBM (PORTABLE BIT MAP) DRIVER         **
C               ******************************************************
C
12000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 130--                                      **
C               **  TREAT THE MACINTOSH              DRIVER         **
C               **  LIBRARY FROM ABSOFT COMPILER                    **
C               ******************************************************
C
13000 CONTINUE
      GOTO9000
C
C               ******************************************************
C               **  STEP 135--                                      **
C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
C               ******************************************************
C
13500 CONTINUE
      IF(JJUST.EQ.1)THEN
        IAQJUS=8+0
      ELSEIF(JJUST.EQ.2)THEN
        IAQJUS=8+1
      ELSEIF(JJUST.EQ.3)THEN
        IAQJUS=8+2
      ELSEIF(JJUST.EQ.4)THEN
        IAQJUS=0 + 0
      ELSEIF(JJUST.EQ.5)THEN
        IAQJUS=0+1
      ELSEIF(JJUST.EQ.6)THEN
        IAQJUS=0+2
      ELSEIF(JJUST.EQ.7)THEN
        IAQJUS=16 + 0
      ELSEIF(JJUST.EQ.8)THEN
        IAQJUS=16 + 1
      ELSEIF(JJUST.EQ.9)THEN
        IAQJUS=16 + 2
      ELSE
        IAQJUS=8
      ENDIF
      AROT=90.0
CAQUA aqtAddLabel(ICTEXT(1:NCTEXT),PX1,PY1,AROT,IAQJUS)
      GOTO9000
C
C               ******************************************************
C               **  STEP 140--                                      **
C               **  TREAT THE PC PRINTER             DRIVER         **
C               ******************************************************
C
14000 CONTINUE
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 150--                                      **
C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
C               ******************************************************
C
15000 CONTINUE
C
CCCCC NOTE: ALTHOUGH THE ROTATEBOX APPROACH IS DESIRED (SO
CCCCC       VERTICAL TEXT WILL BE ROTATED), THIS DOES NOT
CCCCC       SEEM TO WORK WITH MBOX (I NEED MBOX IN ORDER TO
CCCCC       GENERATE THE APPROPRIATE JUSTIFICATION).  SO
CCCCC       FOR NOW, USE THE SHORTSTACK APPROACH INSTEAD
CCCCC       (THIS PLOTS THE VERTICAL STRING AS A COLUMN OF
CCCCC       HORIZONTAL CHARACTERS).
C
      NCSTR=0
      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IBASLC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+3)='put('
      NCSTR=NCSTR+3
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
      ICSTR(NCSTR+2:NCSTR+2)=IBASLC
      NCSTR=NCSTR+15
C
      IF(IJUSTV.EQ.'CENT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='c'
      ELSEIF(IJUSTV.EQ.'BOTT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='b'
      ELSEIF(IJUSTV.EQ.'TOP ')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='t'
      ENDIF
C
      IF(IJUSTH.EQ.'CENT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='c'
      ELSEIF(IJUSTH.EQ.'LEFT')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='l'
      ELSEIF(IJUSTH.EQ.'RIGH')THEN
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='r'
      ENDIF
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=']'
C
      DO15110J=1,NCTEXT
        ICSTR2(J:J)=ICTEXT(J)(1:1)
15110 CONTINUE
      MAXWID=130
      CALL LATCON(ICSTR2,NCTEXT,ICSTR3,NCTEX2,MAXWID,ISUBRO,IERROR)
C
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='{'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IBASLC
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+13)='rotatebox{90}{'
      NCSTR=NCSTR+13
      ICNT=NCSTR
      DO15102J=1,NCTEX2
        ICNT=ICNT+1
        ICSTR(ICNT:ICNT)=ICSTR3(J:J)
15102 CONTINUE
      NCSTR=ICNT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+2)='}}}'
      NCSTR=NCSTR+2
C
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      GOTO9000
C
C               ******************************************************
C               **  STEP 160--                                      **
C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
C               ******************************************************
C
16000 CONTINUE
C
      CALL GRTRSD(PX1P,PY1,IX,IY,ISUBN0)
C
      CALL DPCONA(34,IQUOTE)
C
      ICSTR(1:11)='   <text x='
      NCSTR=12
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+2)=' y='
      NCSTR=NCSTR+3
      ICSTR(NCSTR:NCSTR)=IQUOTE
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      NCSTR=19
      NCSTR=NCSTR+1
      ICSTR(1:19)='         transform='
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR+10)='rotate(-90,'
      NCSTR=NCSTR+10
      NCHTOT=5
      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=','
      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=')'
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=IQUOTE
      NCSTR=-NCSTR
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      IF(ISVGSS(1:3).EQ.'EXT')THEN
        NCSTR=12
        ICSTR(1:NCSTR)='      class='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
C
        IF(IJUSTH.EQ.'CENT')THEN
          ICSTR(NCSTR:NCSTR+16)='center-horizontal'
          NCSTR=NCSTR+17
        ELSEIF(IJUSTH.EQ.'LEFT')THEN
          ICSTR(NCSTR:NCSTR+14)='left-horizontal'
          NCSTR=NCSTR+15
        ELSEIF(IJUSTH.EQ.'RIGH')THEN
          ICSTR(NCSTR:NCSTR+15)='right-horizontal'
          NCSTR=NCSTR+16
        ENDIF
C
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        CALL GRTRCO('FORE',ISVGFC,JCOL2)
        IFLAG=0
        IF(JCOL2.NE.JCOL)THEN
          IFLAG=1
          ICSTR(1:12)='      style='
          ICSTR(13:13)=IQUOTE
          NCSTR=-13
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
          ICSTR(1:21)='             stroke:#'
          NCSTR=21
          NCHTOT=2
          JTEMP=JCOL
          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
          JRED=IRED(JTEMP)
          CALL DPCONX(JRED,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JGREEN=IGREEN(JTEMP)
          CALL DPCONX(JGREEN,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+1
          JBLUE=IBLUE(JTEMP)
          CALL DPCONX(JBLUE,ICJUNK)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
          NCSTR=NCSTR+2
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        ENDIF
        IF(JHEIG2.NE.9)THEN
          IF(IFLAG.EQ.0)THEN
            ICSTR(1:12)='      style='
            ICSTR(13:13)=IQUOTE
            NCSTR=-13
            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
            IFLAG=1
          ENDIF
          NCSTR=22
          ICSTR(1:NCSTR)='            font-size:'
          NCHTOT=3
          CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=';'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
       ENDIF
       IF(IFLAG.EQ.1)THEN
          NCSTR=13
          ICSTR(1:NCSTR)='             '
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)=IQUOTE
          NCSTR=NCSTR+1
          ICSTR(NCSTR:NCSTR)='>'
          NCSTR=-NCSTR
          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
       ENDIF
C
      ELSE
C
        NCSTR=14
        ICSTR(1:NCSTR)='        style='
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCSTR=21
        ICSTR(1:NCSTR)='         font-family:'
        DO16010I=32,1,-1
          NCTEMP=I
          IF(ISVGFN(I:I).NE.' ')GOTO16011
16010   CONTINUE
16011   CONTINUE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
        NCSTR=NCSTR+NCTEMP
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        IF(ISVGFW.EQ.'NORM')THEN
          NCSTR=28
          ICSTR(1:NCSTR)='         font-weight:normal;'
          NCSTR=-NCSTR
        ELSE
          NCSTR=26
          ICSTR(1:NCSTR)='         font-weight:bold;'
          NCSTR=-NCSTR
        ENDIF
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
        IF(ISVGST.EQ.'ITAL')THEN
          NCSTR=27
          ICSTR(1:NCSTR)='         font-style:italic;'
          NCSTR=-NCSTR
        ELSE
          NCSTR=27
          ICSTR(1:NCSTR)='         font-style:normal;'
          NCSTR=-NCSTR
        ENDIF
        NCSTR=19
        ICSTR(1:NCSTR)='         font-size:'
        NCHTOT=3
        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=';'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        IF(IJUSTH.EQ.'CENT')THEN
          NCSTR=29
          ICSTR(1:NCSTR)='         text-anchor:Middle;'
        ELSEIF(IJUSTH.EQ.'RIGH')THEN
          NCSTR=25
          ICSTR(1:NCSTR)='         text-anchor:End;'
        ELSE
          NCSTR=28
          ICSTR(1:NCSTR)='         text-anchor:Start;'
        ENDIF
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        ICSTR(1:21)='         stroke:#'
        NCSTR=17
        NCHTOT=2
        JTEMP=JCOL
        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
        JRED=IRED(JTEMP)
        CALL DPCONX(JRED,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JGREEN=IGREEN(JTEMP)
        CALL DPCONX(JGREEN,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        JBLUE=IBLUE(JTEMP)
        CALL DPCONX(JBLUE,ICJUNK)
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
        NCSTR=NCSTR+1
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
        NCSTR=9
        ICSTR(1:NCSTR)='         '
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)=IQUOTE
        NCSTR=NCSTR+1
        ICSTR(NCSTR:NCSTR)='>'
        NCSTR=-NCSTR
        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ENDIF
C
      DO16112J=1,NCTEXT
      ICSTR(J:J)=ICTEXT(J)
16112 CONTINUE
      NCSTR=-NCTEXT
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
C
      ICSTR(1:10)='   </text>'
      NCSTR=-10
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      GOTO9000
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTV')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRWRTV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PX1,PY1
 9013 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PX99,PY99
 9014 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEXT
 9015 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ICTEXT(I),I=1,NCTEXT)
 9016 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)JSIZE
 9017 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,JDIR
 9023 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILL,JFILL
 9025 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)PTHICK,JTHICK,PTHIC2
 9031 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)PXDEL,PYDEL
 9035 FORMAT('PXDEL,PYDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IC4,IC,IC1,IC2
 9036 FORMAT('IC4,IC,IC1,IC2 = ',A4,2X,A1,2X,A1,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)PXINC,PYINC
 9037 FORMAT('PXINC,PYINC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)PXINC2,PYINC2
 9038 FORMAT('PXINC2,PYINC2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)NCSTR
 9043 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9047
      DO9045I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
 9046 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9045 CONTINUE
 9047 CONTINUE
      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
